home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / btv115.zip / BTV.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-02  |  114KB  |  2,777 lines

  1. {*
  2. * ┌───────────────────────────────────────────────────────────────┐
  3. * │ BTV.PAS  Version 1.15                                         │
  4. * │                                                               │
  5. * │ BTRIEVE object oriented interface for Turbo Pascal 6.0.       │
  6. * │                                                               │
  7. * │ Copyright (c) 1992 by Richard W. Hansen, all rights reserved. │
  8. * └───────────────────────────────────────────────────────────────┘
  9. *
  10. *
  11. *  Requires Turbo Pascal version 6.0
  12. *
  13. *
  14. *  Registration and payment of a license fee is required for any use, whether
  15. *  in whole or part, of this source code.
  16. *
  17. *}
  18.  
  19. {****************************************************************************}
  20. {*   REVISION HISTORY                                                       *}
  21. {*                                                                          *}
  22. {*  Date     Who  What                                                      *}
  23. {* ======================================================================== *}
  24. {* 02/01/92  RWH  Changed DataSize, BytesRead, BytesToWrite from Integer to *}
  25. {*                Word so variable length records can be up to 64K.         *}
  26. {* 02/04/92  RWH  Check that memory allocation size > 0 before issuing an   *}
  27. {*                out of memory error.                                      *}
  28. {*                Added ErrorHandler calls for out of memory errors.        *}
  29. {* 02/08/92  RWH  Added error setting routines to the file object, so calls *}
  30. {*                through the error handler object pointer are not needed.  *}
  31. {* 02/20/92  RWH  Fixed bug in Clone. Wrong file name being used caused     *}
  32. {*                lockup.                                                   *}
  33. {* 02/28/92  RWH  Added Recover, Save and Load methods.                     *}
  34. {* 03/14/92  RWH  Open was not calculating the largest key correctly.       *}
  35. {* 04/25/92  RWH  Added the FillKeyBuffer method.                           *}
  36. {* 05/13/92  RWH  Fixed problem with KeyStart buffer not being setup when   *}
  37. {*                key segments not defined before opening a file.           *}
  38. {*                Changed Error Handler and Error Display in fields in all  *}
  39. {*                objects, and the corresponding parameters in methods, to  *}
  40. {*                pointers. This allows nil objects.                        *}
  41. {****************************************************************************}
  42.  
  43. Unit Btv;
  44. {$F-}
  45. {$V-}
  46. {$X+}
  47. {$A-}
  48.  
  49.  
  50. {$DEFINE BCHECK}    { Define this to check for Btrieve during initialization }
  51. {$DEFINE BTRIEVE50} { Define this to make all opcodes new in V 5.0 available }
  52.  
  53.  
  54. INTERFACE
  55.  
  56.  
  57. USES
  58.   Dos,    { Turbo DOS interface         }
  59.   Btrv6,  { Btrieve Interrupt Interface }
  60.   Tone;   { This unit has substitute Delay and Sound routines for }
  61.           { use with Turbo Vision and is used here instead of the }
  62.           { Turbo CRT unit. The only routine needed is Delay. You }
  63.           { may substitute CRT if desired.                        }
  64.  
  65.  
  66. CONST
  67.   {----- Btrieve operation codes -----}
  68.   bOpen               = 0;
  69.   bClose              = 1;
  70.   bInsert             = 2;
  71.   bUpdate             = 3;
  72.   bDelete             = 4;
  73.   bGetEqual           = 5;
  74.   bGetNext            = 6;
  75.   bGetPrev            = 7;
  76.   bGetGreat           = 8;
  77.   bGetGreatEqual      = 9;
  78.   bGetLess            = 10;
  79.   bGetLessEqual       = 11;
  80.   bGetFirst           = 12;
  81.   bGetLast            = 13;
  82.   bCreate             = 14;
  83.   bStat               = 15;
  84.   bBeginTransaction   = 19;
  85.   bEndTransaction     = 20;
  86.   bAbortTransaction   = 21;
  87.   bGetPosition        = 22;
  88.   bGetDirect          = 23;
  89.   bStepNext           = 24;
  90.   bStop               = 25;
  91.   bVersion            = 26;
  92.   bUnlock             = 27;
  93.   bReset              = 28;
  94.   bSetOwner           = 29;
  95.   bClearOwner         = 30;
  96.   bCreateIndex        = 31;
  97.   bDropIndex          = 32;
  98.   bStepFirst          = 33;
  99.   bStepLast           = 34;
  100.   bStepPrev           = 35;
  101.   bGetNextExt         = 36;
  102.   bGetPrevExt         = 37;
  103.   bStepNextExt        = 38;
  104.   bStepPrevExt        = 39;
  105.   bInsertExt          = 40;
  106.  
  107.   bGetKey             = 50;
  108.  
  109.   {----- Btrieve Status Codes -----}
  110.   bOkay               = 0;
  111.   bInvalidOp          = 1;
  112.   bIOerror            = 2;
  113.   bFileNotOpen        = 3;
  114.   bKeyNotFound        = 4;
  115.   bDuplicateKey       = 5;
  116.   bInvalidKey         = 6;
  117.   bDifferentKey       = 7;
  118.   bInvalidPos         = 8;
  119.   bEOF                = 9;
  120.   bKeyModifyErr       = 10;
  121.   bInvalidName        = 11;
  122.   bFileNotFound       = 12;
  123.   bExtendedFileErr    = 13;
  124.   bPreImageOpenErr    = 14;
  125.   bPreImageIOErr      = 15;
  126.   bExpansionErr       = 16;
  127.   bCloseErr           = 17;
  128.   bDiskFull           = 18;
  129.   bUnRecoverableErr   = 19;
  130.   bNotLoaded          = 20;
  131.   bKeyBufferShort     = 21;
  132.   bDataBufferShort    = 22;
  133.   bPosBlockShort      = 23;
  134.   bPageSizeErr        = 24;
  135.   bCreateIOErr        = 25;
  136.   bNumberKeys         = 26;
  137.   bInvalidKeyPos      = 27;
  138.   bRecordLenErr       = 28;
  139.   bKeyLenErr          = 29;
  140.   bNotBtrieveFile     = 30;
  141.   bFileExtended       = 31;
  142.   bExtendIOErr        = 32;
  143.   bExtendNameErr      = 34;
  144.   bDirectoryErr       = 35;
  145.   bTransactionErr     = 36;
  146.   bTransactionActive  = 37;
  147.   bTransactionFileErr = 38;
  148.   bTransactionEndErr  = 39;
  149.   bTransactionMaxFiles= 40;
  150.   bOpNotAllowed       = 41;
  151.   bAcceleratedErr     = 42;
  152.   bInvalidAddress     = 43;
  153.   bNullKeypath        = 44;
  154.   bBadKeyFlags        = 45;
  155.   bFileAccessDenied   = 46;
  156.   bMaxOpenFiles       = 47;
  157.   bInvalidAltSequence = 48;
  158.   bKeyTypeErr         = 49;
  159.   bOwnerIsSet         = 50;
  160.   bInvalidOwner       = 51;
  161.   bCacheWriteErr      = 52;
  162.   bInvalidVersion     = 53;
  163.   bVariablePageErr    = 54;
  164.   bAutoIncrementErr   = 55;
  165.   bBadIndex           = 56;
  166.   bExpandedMemoryErr  = 57;
  167.   bCompressBuffShort  = 58;
  168.   bFileExists         = 59;
  169.   bRejectMax          = 60;
  170.   bWorkSpaceShort     = 61;
  171.   bDescriptorErr      = 62;
  172.   bExtInsertBuffErr   = 63;
  173.   bFilterLimit        = 64;
  174.   bFieldOffsetErr     = 65;
  175.   bTTSabort           = 74;
  176.   bDeadlock           = 78;
  177.   bConflict           = 80;
  178.   bLockErr            = 81;
  179.   bLostPosition       = 82;
  180.   bOutOfTransaction   = 83;
  181.   bRecordInUse        = 84;
  182.   bFileInUse          = 85;
  183.   bFileTblFull        = 86;
  184.   bHandleTblFull      = 87;
  185.   bBadModeErr         = 88;
  186.   bDeviceTableFull    = 90;
  187.   bServerErr          = 91;
  188.   bTranTableFull      = 92;
  189.   bBadLockType        = 93;
  190.   bPermissionErr      = 94;
  191.   bSessionInvalid     = 95;
  192.   bCommunicationErr   = 96;
  193.   bDataMessageShort   = 97;
  194.   bInternalTTSerr     = 98;
  195.   bOutOfMemory        = 120;
  196.   bDuplicateFilename  = bOutOfMemory + 1;
  197.   bLoadInputErr       = bDuplicateFilename + 1;
  198.   bLastError          = bLoadInputErr;
  199.  
  200.   {----- Btrieve constants -----}
  201.   bNormal             = 0;
  202.  
  203.   bRJustify           = 1;        { String justification types }
  204.   bLJustify           = 2;
  205.  
  206.   bNoOverWrite        = -1;       { File create mode }
  207.  
  208.   bReadAccess         = 1;        { File owner access modes }
  209.   bWriteAccessEncrypt = 2;
  210.   bReadAccessEncrypt  = 3;
  211.  
  212.   bVariableLen        = 1;        { File flags }
  213.   bBlankTruncate      = 2;
  214.   bPreallocate        = 4;
  215.   bDataCompress       = 8;
  216.   bKeyOnly            = 16;
  217.   b10Free             = 64;
  218.   b20Free             = 128;
  219.   b30Free             = 192;
  220.  
  221.   bAccelerated        = -1;       { File open modes }
  222.   bReadOnly           = -2;
  223.   bVerify             = -3;
  224.   bExclusive          = -4;
  225.  
  226.   bDuplicates         = 1;        { Key flags }
  227.   bModifiable         = 2;
  228.   bBinary             = 4;
  229.   bNull               = 8;
  230.   bSegmented          = 16;
  231.   bAltSequence        = 32;
  232.   bDescending         = 64;
  233.   bSupplemental       = 128;
  234.   bExtended           = 256;
  235.   bManual             = 512;
  236.  
  237.   bString             = 0;        { Key types }
  238.   bInteger            = 1;
  239.   bFloat              = 2;
  240.   bDate               = 3;
  241.   bTime               = 4;
  242.   bDecimal            = 5;
  243.   bMoney              = 6;
  244.   bLogical            = 7;
  245.   bNumeric            = 8;
  246.   bBfloat             = 9;
  247.   bLstring            = 10;
  248.   bZstring            = 11;
  249.   bUnsigned           = 14;
  250.   bAutoIncrement      = 15;
  251.  
  252.   bNoLock             = 0;        { Lock types }
  253.   bSingleWait         = 100;
  254.   bSingleNoWait       = 200;
  255.   bMultipleWait       = 300;
  256.   bMultipleNoWait     = 400;
  257.  
  258.  
  259.   PosBlockSize        = 128;
  260.  
  261.   MaxSegments         = 24;       { maximum number of segments in a key   }
  262.   MaxBuffSize         : Word = 16 * 1024; { 16k max buffer size in bytes  }
  263.  
  264.  
  265.  
  266. TYPE
  267.   AllErrors     = bInvalidOp..bLastError;
  268.     {- a superset of all Btrieve errors allowing for customization }
  269.  
  270.   ErrorSet      = Set of AllErrors;
  271.     {- will hold Btrieve errors and possibly some custom error codes }
  272.  
  273.   ErrorAction = (erAbort, erDone, erRetry);
  274.     {- the possible return states from an error              }
  275.     {- these codes are returned by the error display routine }
  276.  
  277.  
  278.   PBytes        = ^Bytes;
  279.   Bytes         = Array[1..65534] of Byte;
  280.     {- define a byte array and pointer to make access easier }
  281.  
  282.  
  283.   PProgress = ^TProgress;
  284.   TProgress = Object
  285.     Constructor Init;
  286.     Procedure   Display(Count : LongInt);         Virtual;
  287.   end;
  288.     {- object to display progress for recover, save and load }
  289.  
  290.  
  291.   { Btrieve key specs record }
  292.   KeySpec       = record
  293.     KeyPos    : Word;           { position of key or segment in data      }
  294.     KeyLen    : Word;           { length of the key or segment            }
  295.     KeyFlags  : Word;           { key flags as defined by Btrieve         }
  296.     KeyCount  : LongInt;        { not used except for STAT                }
  297.     KeyType   : Byte;           { extended key type                       }
  298.     NullValue : Byte;           { null character if defined               }
  299.     Reserved  : Array[1..4] of Byte;
  300.   end;
  301.  
  302.   KeySpecArray   = Array[1..MaxSegments] of KeySpec;
  303.  
  304.  
  305.   { Our own key definition record }
  306.   KeyDef        = record
  307.     KeyPos    : Word;         { position of key or segment in data      }
  308.     KeyLen    : Word;         { length of the key or segment            }
  309.     KeyFlags  : Word;         { key flags as defined by Btrieve         }
  310.     KeyType   : Byte;         { extended key type                       }
  311.     NullValue : Byte;         { null character if defined               }
  312.     Justify   : Byte;         { lString justification type              }
  313.   end;
  314.  
  315.   KeyDefArray     = Array[1..MaxSegments] of KeyDef;
  316.  
  317.  
  318.   { Btrieve file specs record }
  319.   FileSpec      = record
  320.     RecordLen : Word;           { length of a record in the file          }
  321.     PageSize  : Word;           { physical page size for file             }
  322.     Indexes   : Word;           { number of keys                          }
  323.     Records   : LongInt;        { not used except for STAT                }
  324.     FileFlags : Word;           { file flags as defined by Btrieve        }
  325.     Reserved  : Array[1..2] of Byte;
  326.     FreePages : Word;           { pages to pre allocate                   }
  327.     KeyBuff   : KeySpecArray;   { array of key info (one for each segment)}
  328.     Extra     : Array[1..265] of Byte; { might be needed for alt. sequence}
  329.   end;
  330.  
  331.  
  332.  
  333.   { This is the object that will display errors to the user.              }
  334.   { This is an ABSTRACT object and should never be instantiated, you must }
  335.   { define a descendant object that does what you want in each program.   }
  336.   PErrorDisplay  = ^ErrorDisplay;
  337.   ErrorDisplay   = Object
  338.     Constructor Init;
  339.       {- init the error display }
  340.  
  341.     Function    Display(Error     : Integer;
  342.                         ErrorMsg  : String;
  343.                         OpCode    : Byte;
  344.                         OpCodeMsg : String;
  345.                         FileName  : PathStr
  346.                         ): ErrorAction;             Virtual;
  347.       {- display the error, returns True if program should abort }
  348.  
  349.     Destructor  Done;                               Virtual;
  350.       {- destroy the object }
  351.   end;
  352.  
  353.  
  354.  
  355.   { This is the error object used by the file to trap IO errors.  }
  356.   PErrorHandler   = ^ErrorHandler;
  357.   ErrorHandler    = Object
  358.     RetryCount    : Word;         { current number of retries on an error   }
  359.     MaxRetry      : Word;         { maximum number of retries on an error   }
  360.     RetryDelay    : Word;         { milliseconds between retries            }
  361.     TrappedErrors : ErrorSet;     { errors this object will handle          }
  362.     ErrDisplay    : PErrorDisplay;{ pointer to an error display object      }
  363.  
  364.     Constructor Init(DisplayObject : PErrorDisplay);
  365.       {- initialize the error object }
  366.  
  367.     Function    ErrorDispacther(ErrorCode : Integer;
  368.                                 OpCode    : Byte;
  369.                                 FileName  : PathStr
  370.                                ): ErrorAction;      Virtual;
  371.       {- send errors and messages to the user error display }
  372.  
  373.     Function    Error(Status   : Integer;
  374.                       OpCode   : Byte;
  375.                       FileName : PathStr
  376.                      ): Boolean;                    Virtual;
  377.       {- check for errors and control the number of retries after an error }
  378.  
  379.     Procedure   SetMaxRetry(Retry : Word);
  380.       {- set the maximum retries per error }
  381.  
  382.     Function    GetMaxRetry: Word;
  383.       {- return the maximum retries per error }
  384.  
  385.     Procedure   ClearRetry;
  386.       {- clear the current count of retries }
  387.  
  388.     Procedure   SetDelay(Seconds : Word);
  389.       {- set the delay in seconds between retries }
  390.  
  391.     Function    GetDelay: Word;
  392.       {- return the delay in seconds between retries }
  393.  
  394.     Procedure   AddErrors(ErrorCodes : ErrorSet);
  395.       {- add an error to the set of errors trapped }
  396.  
  397.     Procedure   RemoveErrors(ErrorCodes : ErrorSet);
  398.       {- remove an error from the set of errors trapped }
  399.  
  400.     Procedure   SetErrors(ErrorCodes : ErrorSet);
  401.       {- set the entire trapped error set }
  402.  
  403.     Procedure   GetErrors(var ErrorCodes : ErrorSet);
  404.       {- get the trapped error set }
  405.  
  406.     Function    ErrorMsg(ErrorCode : Integer): String; Virtual;
  407.       {- return an error message for a Btrieve error code }
  408.  
  409.     Function    OpMsg(OpCode : Integer): String; Virtual;
  410.       {- return a message for a Btrieve operation code }
  411.  
  412.     Destructor  Done;                               Virtual;
  413.       {- destroy the object }
  414.   end;
  415.  
  416.  
  417.  
  418.   { This is the Btrieve file file interface object  }
  419.   PBtrieveFile  = ^BtrieveFile;
  420.   BtrieveFile   = Object
  421.     Path        : PathStr;            { File name and path                }
  422.     AltPath     : PathStr;            { Alternate collating seq. file     }
  423.     Data        : Pointer;            { pointer to record data buffer     }
  424.     DataSize    : Word;               { length of record data buffer      }
  425.     Allocate    : Boolean;            { allocate data buffer memory       }
  426.     BytesRead   : Word;               { number of bytes on last file read }
  427.     BytesToWrite: Word;               { number of bytes to write to file  }
  428.     Key         : Pointer;            { pointer to the file key buffer    }
  429.     KeySize     : Byte;               { actual size of the key buffer     }
  430.     SegmentCnt  : Byte;               { total number of key segments      }
  431.     CurIndex    : Word;               { current key being used            }
  432.     IndexCnt    : Byte;               { number of defined keys            }
  433.     Status      : Integer;            { status of last Btrieve operation  }
  434.     FileOpen    : Boolean;            { is the file open                  }
  435.     ErrHandler  : PErrorHandler;      { pointer to the error handler      }
  436.     KeyList     : KeyDefArray;        { list of key definitions           }
  437.                                       { offset of 1st segment in each key }
  438.     KeyStart    : Array[0..MaxSegments - 1] of Byte;
  439.                                       { position block for Btrieve        }
  440.     PosBlock    : Array[1..PosBlockSize] of Byte;
  441.     VariableLen : Boolean;            { does file use var length records  }
  442.     SISegments  : Byte;
  443.     ReadKeyDefs : Boolean;
  444.     CurrentKeySize : Byte;
  445.  
  446.     Constructor Init(FilePath    : PathStr;
  447.                      ErrorObject : PErrorHandler;
  448.                      DataBuf     : Pointer;
  449.                      DataBufSize : Word);
  450.       {- initialize a file object }
  451.  
  452.     Destructor  Done;                               Virtual;
  453.       {- destroy the object }
  454.  
  455.     Procedure   AddAltSequence(AltSeqPath : PathStr);
  456.       {- add an alternate collating sequence file }
  457.  
  458.     Procedure   AddKeySegment(Position  : Word;
  459.                               Size      : Word;
  460.                               Flags     : Word;
  461.                               KeyType   : Byte;
  462.                               NullValue : Byte;
  463.                               Justify   : Byte);
  464.       {- define a key segment }
  465.  
  466.     Procedure   Open(Mode : Integer;
  467.                      Owner: String);
  468.       {- open the file }
  469.  
  470.     Procedure   Close;
  471.       {- close the file }
  472.  
  473.     Procedure   Create(Flags      : Word;
  474.                        RecordSize : Word;
  475.                        PageSize   : Word;
  476.                        Pages      : Word;
  477.                        Mode       : Integer);
  478.       {- create the file }
  479.  
  480.     Procedure   Clone(NewFilePath : PathStr;
  481.                       Mode        : Integer);
  482.       {- clone an empty copy of the file }
  483.  
  484.     Function    Error(ErrStatus : Integer;
  485.                       OpCode    : Byte;
  486.                       FileName  : PathStr
  487.                      ): Boolean;
  488.       {- call the error handler to check for errors }
  489.  
  490.     Function    Recover(NewFilePath : PathStr;
  491.                         DisplayObj  : PProgress): Integer;
  492.       {- copy all possible records to a new Btrieve file }
  493.  
  494.     Function    Save(NewFilePath : PathStr;
  495.                      DisplayObj  : PProgress): Integer;
  496.       {- write the contents of the file to a DOS file }
  497.  
  498.     Function    Load(InputFilePath : PathStr;
  499.                      DisplayObj    : PProgress): Integer;
  500.       {- read the contents of a DOS file and insert }
  501.  
  502.     Procedure   AddSupplKeySegment(Position  : Word;
  503.                                    Size      : Word;
  504.                                    Flags     : Word;
  505.                                    KeyType   : Byte;
  506.                                    NullValue : Byte;
  507.                                    Justify   : Byte);
  508.       {- define a key segment for a supplemental index }
  509.  
  510.     Procedure   CreateIndex;
  511.       {- add a supplemental index to the file }
  512.  
  513.     Procedure   DropIndex(Index : Integer);
  514.       {- remove a supplemental index from the file }
  515.  
  516.     Procedure   SetOwner(Owner  : String;
  517.                          Mode   : Integer);
  518.       {- set the file owner }
  519.  
  520.     Procedure   ClearOwner;
  521.       {- set the file owner }
  522.  
  523.     Procedure   SetKeyPath(Number : Word);
  524.       {- change the current file key path }
  525.  
  526.     Procedure   MakeKey(V1 : Pointer;
  527.                         V2 : Pointer;
  528.                         V3 : Pointer;
  529.                         V4 : Pointer;
  530.                         V5 : Pointer;
  531.                         V6 : Pointer);
  532.       {- copy the passed fields into the key buffer }
  533.  
  534.     Procedure   Get(Op   : Word;
  535.                     Lock : Word);
  536.       {- read a record using by a key }
  537.  
  538.     Procedure   GetDirect(Lock     : Word;
  539.                           Position : LongInt);
  540.       {- read a record by file position }
  541.  
  542.     Function    GetPosition: LongInt;
  543.       {- return the position of the record }
  544.  
  545.     Procedure   UnlockAll(Lock : Word);
  546.       {- unlock all records in the file }
  547.  
  548.     Procedure   Insert;
  549.       {- add a new record to the file }
  550.  
  551.     Procedure   Update;
  552.       {- update an existing record in the file }
  553.  
  554.     Procedure   SetOutputSize(Size : Word);
  555.       {- use for variable length records only, sets the size of the
  556.          record to be written to the file  }
  557.  
  558.     Procedure   AddErrors(ErrorCodes : ErrorSet);
  559.       {- add an error to the set of errors trapped }
  560.  
  561.     Procedure   RemoveErrors(ErrorCodes : ErrorSet);
  562.       {- remove an error from the set of errors trapped }
  563.  
  564.     Procedure   SetErrors(ErrorCodes : ErrorSet);
  565.       {- set the entire trapped error set }
  566.  
  567.     Procedure   GetErrors(var ErrorCodes : ErrorSet);
  568.       {- get the trapped error set }
  569.  
  570.     Procedure   Delete;
  571.       {- delete the current record }
  572.  
  573.     Procedure   ClearBuffer;
  574.       {- zero fill the file data buffer }
  575.  
  576.     Procedure   ClearKey;
  577.       {- zero fill the file key buffer }
  578.  
  579.     Procedure   FillKeyBuffer(var Buff; Size : Byte);
  580.       {- fill the key buffer from the data in Buff }
  581.  
  582.     Procedure   ChangeBufferSize(Size : Word);
  583.       {- change the size of the output buffer }
  584.  
  585.     Procedure   Stat(var FData : FileSpec);
  586.       {- get the file statistics }
  587.  
  588.     Function    bResult: Integer;
  589.       {- return the last IO status }
  590.  
  591.     Function    IsOpen: Boolean;
  592.       {- return True if the file is open }
  593.  
  594.     Function    NumberOfRecords: LongInt;
  595.       {- return the number of records in the file }
  596.  
  597.     Procedure   StartTransaction(Lock : Word);
  598.     Procedure   EndTransaction;
  599.     Procedure   AbortTransaction;
  600.       {- routines to control transaction processing }
  601.  
  602.     Procedure   Unload;
  603.       {- unload Btrieve }
  604.  
  605.     Procedure   Reset;
  606.       {- reset Btrieve }
  607.  
  608.     Procedure   Version(var Ver    : Word;
  609.                         var Rev    : Word;
  610.                         var OSFlag : Char);
  611.       {- get Btrieve version }
  612.  
  613.     Procedure   FixKeyStrings;
  614.   end;
  615.  
  616.  
  617. Procedure CheckForBtrieve;
  618.  
  619.  
  620. {============================================================================}
  621. IMPLEMENTATION
  622.  
  623.  
  624. Procedure Pad(var S   : String;
  625.                   Len : Byte);
  626.   {-Return a string right-padded to length len with blanks}
  627.   var
  628.     SLen : Byte Absolute S;
  629.  
  630.   begin
  631.     if (SLen < Len) then
  632.     begin
  633.       FillChar(S[SLen + 1], Len - SLen, ' ');
  634.       SLen := Len;
  635.     end;
  636.   end;
  637.  
  638. Procedure LeftPad(var S   : String;
  639.                       Len : Byte);
  640.   {-Return a string left-padded to length len with blanks}
  641.   var
  642.     SLen : Byte Absolute S;
  643.     X    : Byte;
  644.  
  645.   begin
  646.     if (SLen < Len) then
  647.     begin
  648.       X := Len - SLen;
  649.       Move(S[1], S[X + 1], SLen);
  650.       FillChar(S[1], X, ' ');
  651.       SLen := Len;
  652.     end;
  653.   end;
  654.  
  655. Procedure Trim(var S : String);
  656.   {- Return a string with leading and trailing blanks removed }
  657.   var
  658.     I    : Word;
  659.     SLen : Byte absolute S;
  660.  
  661.   begin
  662.     while (SLen > 0) and (S[SLen] <= ' ') do
  663.       Dec(SLen);
  664.  
  665.     I := 1;
  666.  
  667.     while (I <= SLen) and (S[I] <= ' ') do
  668.       Inc(I);
  669.  
  670.     if (I > 1) then
  671.     begin
  672.       SLen := SLen - I + 1;
  673.       Move(S[I], S[1], SLen);
  674.     end;
  675.   end;
  676.  
  677.  
  678. {****************************************************************************
  679.                             File Object
  680. ****************************************************************************}
  681. {+--------------------------------------------------------------------------+}
  682. {| Name       : Init                                                        |}
  683. {| Class      : BtrieveFile                                                 |}
  684. {| Purpose    : Initialize the file object                                  |}
  685. {| Parameters : FilePath     - Path name of the data file.                  |}
  686. {|              ErrorObject  - Pointer to an error handler object.          |}
  687. {|              DataBuf      - Pointer to a data buffer, set to nil and     |}
  688. {|                             memory will be automatically allocated when  |}
  689. {|                             the file is opened.                          |}
  690. {|              DataBufSize  - Size of what DataBuf points at, can be zero  |}
  691. {|                             if DataBuf is nil.                           |}
  692. {| Returns    : none                                                        |}
  693. {+--------------------------------------------------------------------------+}
  694. Constructor BtrieveFile.Init(FilePath    : PathStr;
  695.                              ErrorObject : PErrorHandler;
  696.                              DataBuf     : Pointer;
  697.                              DataBufSize : Word);
  698.   begin
  699.     Path        := FilePath;
  700.     AltPath     := '';
  701.     Data        := DataBuf;
  702.     Allocate    := (Data = nil);
  703.  
  704.     if Allocate then
  705.       DataSize  := 0
  706.     else
  707.       DataSize  := DataBufSize;
  708.  
  709.     BytesRead   := 0;
  710.     BytesToWrite:= 0;
  711.     Key         := nil;
  712.     KeySize     := 0;
  713.     CurrentKeySize := 0;
  714.     SegmentCnt  := 0;
  715.     SISegments  := 0;
  716.     IndexCnt    := 0;
  717.     Status      := bOkay;
  718.     FileOpen    := False;
  719.     ErrHandler  := ErrorObject;
  720.     CurIndex    := 0;
  721.     ReadKeyDefs := True;
  722.     FillChar(KeyList,  SizeOf(KeyList), 0);
  723.     FillChar(KeyStart, SizeOf(KeyStart), 0);
  724.     FillChar(PosBlock, SizeOf(PosBlock), 0);
  725.   end;
  726.  
  727. {+--------------------------------------------------------------------------+}
  728. {| Name       : SetKeyPath                                                  |}
  729. {| Class      : BtrieveFile                                                 |}
  730. {| Purpose    : Set the number of the key that will be used for all read and|}
  731. {|              write operations.                                           |}
  732. {| Parameters : Number - the key path to be used                            |}
  733. {| Returns    : none                                                        |}
  734. {+--------------------------------------------------------------------------+}
  735. Procedure BtrieveFile.SetKeyPath(Number : Word);
  736.   begin
  737.     if (Number <= IndexCnt) then
  738.       CurIndex := Number;
  739.   end;
  740.  
  741. {+--------------------------------------------------------------------------+}
  742. {| Name       : AddAltSequence                                              |}
  743. {| Class      : BtrieveFile                                                 |}
  744. {| Purpose    : Define the Path of a disk file that holds an alternate      |}
  745. {|              collating sequence.                                         |}
  746. {| Parameters : AltSeqPath - Alt. sequence file path name.                  |}
  747. {| Returns    : none                                                        |}
  748. {| Notes      : This is an optional feature.                                |}
  749. {+--------------------------------------------------------------------------+}
  750. Procedure BtrieveFile.AddAltSequence(AltSeqPath : PathStr);
  751.   begin
  752.     AltPath := AltSeqPath;
  753.   end;
  754.  
  755. {+--------------------------------------------------------------------------+}
  756. {| Name       : AddKeySegment                                               |}
  757. {| Class      : BtrieveFile                                                 |}
  758. {| Purpose    : Define the next key segment.                                |}
  759. {| Parameters : Position - where it starts in the key                       |}
  760. {|              Size     - number of bytes in this segment                  |}
  761. {|              Flags    - btrieve file flags                               |}
  762. {|              KeyType  - btrieve key type                                 |}
  763. {|              NullValue- null value for this segment                      |}
  764. {|              Justify  - Applies to lStrings only.                        |}
  765. {|                         0 for the string to be left as is.               |}
  766. {|                         1 for the string to be right justified.          |}
  767. {|                         2 for the string to be left justified.           |}
  768. {| Returns    : none                                                        |}
  769. {| Notes      : Segments must be defined in order.                          |}
  770. {|              Must be done once before a file created. May optionally be  |}
  771. {|              done before a file is opened.                               |}
  772. {+--------------------------------------------------------------------------+}
  773. Procedure BtrieveFile.AddKeySegment(Position  : Word;
  774.                                     Size      : Word;
  775.                                     Flags     : Word;
  776.                                     KeyType   : Byte;
  777.                                     NullValue : Byte;
  778.                                     Justify   : Byte);
  779.   begin
  780.     { Open will not read keys definitions from the file }
  781.     ReadKeyDefs := False;
  782.  
  783.     { if more segments are allowed  }
  784.     if (SegmentCnt < MaxSegments) then
  785.     begin
  786.       { increase the current key size by the size of this segment }
  787.       CurrentKeySize := CurrentKeySize + Size;
  788.  
  789.       Inc(SegmentCnt);
  790.  
  791.       { if this is the first segment in the current key
  792.         then add to list of key starting segments
  793.       }
  794.       if (KeyStart[IndexCnt] = 0) then
  795.         KeyStart[IndexCnt] := SegmentCnt;
  796.  
  797.       { add it to the list of key definitions }
  798.       KeyList[SegmentCnt].KeyPos    := Position;
  799.       KeyList[SegmentCnt].KeyLen    := Size;
  800.       KeyList[SegmentCnt].KeyFlags  := Flags;
  801.       KeyList[SegmentCnt].KeyType   := KeyType;
  802.       KeyList[SegmentCnt].NullValue := NullValue;
  803.       KeyList[SegmentCnt].Justify   := Justify;
  804.  
  805.       { if this is the end of all segments for the current key }
  806.       if (Flags And bSegmented = 0) then
  807.       begin
  808.         { bump the number of keys }
  809.         Inc(IndexCnt);
  810.  
  811.         { find the largest key so far }
  812.         if (CurrentKeySize > KeySize) then
  813.           KeySize := CurrentKeySize;
  814.  
  815.         { set for the next key }
  816.         CurrentKeySize := 0;
  817.       end;
  818.     end;
  819.   end;
  820.  
  821. {+--------------------------------------------------------------------------+}
  822. {| Name       : Open                                                        |}
  823. {| Class      : BtrieveFile                                                 |}
  824. {| Purpose    : Open a btrieve file                                         |}
  825. {| Parameters : Mode - mode to open the file in                             |}
  826. {|              Owner- up to 8 character file owner name                    |}
  827. {| Returns    : none                                                        |}
  828. {| Notes      : Allocates memory for key and data buffers.                  |}
  829. {|              If keys are not setup manually, then reads key defs from the|}
  830. {|              file.                                                       |}
  831. {+--------------------------------------------------------------------------+}
  832. Procedure BtrieveFile.Open(Mode  : Integer;
  833.                            Owner : String);
  834.  
  835.   var
  836.     i,j     : Byte;
  837.     OwnerLen: Word;
  838.     FName   : Array[0..80] of Char;
  839.     FData   : FileSpec;
  840.  
  841.   begin
  842.     if not FileOpen then
  843.     begin
  844.       { turn path and name into an ascii zero terminated string }
  845.       Move(Path[1], FName[0], Length(Path));
  846.       FName[Length(Path)] := Chr(0);
  847.       FillChar(FData, SizeOf(FData), 0);
  848.       OwnerLen := 0;
  849.  
  850.       if (Owner <> '') then
  851.       begin
  852.         OwnerLen := Length(Owner);
  853.  
  854.         if (OwnerLen > 8) then
  855.           OwnerLen := 8;
  856.  
  857.         Move(Owner[1], FData, OwnerLen);
  858.       end;
  859.  
  860.       Repeat
  861.         Status := Btrv(bOpen, PosBlock, FData, OwnerLen, FName, Mode);
  862.       Until (not Error(Status, bOpen, Path));
  863.  
  864.       FileOpen := (Status = bOkay);
  865.  
  866.       if FileOpen then
  867.       begin
  868.         { read in all the file data needed  }
  869.         Stat(FData);
  870.  
  871.         if (Status = bOkay) then
  872.         begin
  873.           { set some flags from the file definition }
  874.           IndexCnt    := FData.Indexes;
  875.           VariableLen := ((FData.FileFlags and bVariableLen) <> 0);
  876.           { write size defaults to fixed length size }
  877.           BytesToWrite:= FData.RecordLen;
  878.  
  879.           { if the keys were not setup manually then read from the file }
  880.           if ReadKeyDefs then
  881.           begin
  882.             { check all keys for the largest key size }
  883.             SegmentCnt := 0;
  884.  
  885.             for i := 1 to IndexCnt do
  886.             begin
  887.               { set start of key segments for this key  }
  888.               KeyStart[i] := SegmentCnt + 1;
  889.  
  890.               Repeat
  891.                 { add this length to size of the current key }
  892.                 Inc(SegmentCnt);
  893.  
  894.                 CurrentKeySize := CurrentKeySize +
  895.                                   FData.KeyBuff[SegmentCnt].KeyLen;
  896.               Until ((FData.KeyBuff[SegmentCnt].KeyFlags and bSegmented) = 0);
  897.  
  898.               { compare the size }
  899.               if (CurrentKeySize > KeySize) then
  900.                 KeySize := CurrentKeySize;
  901.  
  902.               { set for the next key }
  903.               CurrentKeySize := 0;
  904.             end; {FOR}
  905.  
  906.             { move key segment data from stat buffer to key def buffer }
  907.             for i := 1 to SegmentCnt do
  908.             begin
  909.               KeyList[i].KeyPos    := FData.KeyBuff[i].KeyPos;
  910.               KeyList[i].KeyLen    := FData.KeyBuff[i].KeyLen;
  911.               KeyList[i].KeyFlags  := FData.KeyBuff[i].KeyFlags;
  912.               KeyList[i].KeyType   := FData.KeyBuff[i].KeyType;
  913.               KeyList[i].NullValue := FData.KeyBuff[i].NullValue;
  914.               KeyList[i].Justify   := bNormal;
  915.             end;  {FOR}
  916.           end;
  917.  
  918.           { allocate memory for the data and key buffers  }
  919.           { if Data does not point at anything then get   }
  920.           { some memory for it                            }
  921.           if Allocate then
  922.           begin
  923.             { if variable length then allocate a bunch of memory  }
  924.             { else just allocate the minium needed                }
  925.             if VariableLen then
  926.               DataSize := MaxBuffSize
  927.             else
  928.               DataSize := FData.RecordLen;
  929.  
  930.             GetMem(Data, DataSize);
  931.           end;
  932.  
  933.           GetMem(Key, KeySize);
  934.  
  935.           if ((Data = nil) and (DataSize > 0)) or
  936.              ((Key = nil)  and (KeySize > 0)) then
  937.           begin
  938.             Status := bOutOfMemory;
  939.             Error(Status, bOpen, Path);
  940.             EXIT;
  941.           end;
  942.  
  943.           { clear the buffers }
  944.           FillChar(Data^, DataSize, ' ');
  945.           FillChar(Key^,  KeySize,  ' ');
  946.           CurrentKeySize  := 0;
  947.         end;
  948.       end;
  949.     end;
  950.   end;
  951.  
  952. {+--------------------------------------------------------------------------+}
  953. {| Name       : Create                                                      |}
  954. {| Class      : BtrieveFile                                                 |}
  955. {| Purpose    : Create a new file                                           |}
  956. {| Parameters : Flags      - Btrieve file flags                             |}
  957. {|              RecordSize - length of the fixed length portion of record   |}
  958. {|              PageSize   - number of bytes in a file page                 |}
  959. {|              Pages      - number of pages to preallocate to the file     |}
  960. {|              Mode       - indicates overwrite or warn mode               |}
  961. {| Returns    : none                                                        |}
  962. {| Notes      : Make sure the keys have been defined.                       |}
  963. {|              Call Open immediately after Create.                         |}
  964. {+--------------------------------------------------------------------------+}
  965. Procedure BtrieveFile.Create(Flags      : Word;
  966.                              RecordSize : Word;
  967.                              PageSize   : Word;
  968.                              Pages      : Word;
  969.                              Mode       : Integer);
  970.  
  971.   var
  972.     i       : Integer;
  973.     BufSize : Word;
  974.     FName   : Array[0..80] of Char;
  975.     Buff    : FileSpec;
  976.     Temp    : Array[1..1024] of Byte Absolute Buff;
  977.     AltFile : File;
  978.  
  979.   begin
  980.     { clear the data buffer }
  981.     FillChar(Buff, SizeOf(Buff), 0);
  982.  
  983.     { copy the file info to the data buffer }
  984.     Buff.RecordLen  := RecordSize;
  985.     Buff.PageSize   := PageSize;
  986.     Buff.Indexes    := IndexCnt;
  987.     Buff.FileFlags  := Flags;
  988.     Buff.FreePages  := Pages;
  989.  
  990.     { copy the key info for each segment to the data buffer }
  991.     for i := 1 to SegmentCnt do
  992.     begin
  993.       Buff.KeyBuff[i].KeyPos    := KeyList[i].KeyPos;
  994.       Buff.KeyBuff[i].KeyLen    := KeyList[i].KeyLen;
  995.       Buff.KeyBuff[i].KeyFlags  := KeyList[i].KeyFlags;
  996.       Buff.KeyBuff[i].KeyType   := KeyList[i].KeyType;
  997.       Buff.KeyBuff[i].NullValue := KeyList[i].NullValue;
  998.     end;
  999.  
  1000.     { calculate the buffer size so far                    }
  1001.     {       Segments * Segment data size + file data size }
  1002.     BufSize := SegmentCnt * SizeOf(KeySpec) + 16;
  1003.  
  1004.     { read the alternate collating sequence if any        }
  1005.     {$I-}
  1006.     if (AltPath <> '') then
  1007.     begin
  1008.       System.Assign(AltFile, AltPath);
  1009.       System.Reset(AltFile, 1);
  1010.  
  1011.       if (IoResult = 0) then
  1012.       begin
  1013.         System.BlockRead(AltFile, Temp[BufSize+1], 265);{ Read file   }
  1014.         System.Close(AltFile);
  1015.         BufSize := BufSize + 265;
  1016.         AltPath := '';
  1017.         i := IoResult;
  1018.       end;
  1019.     end;
  1020.     {$I+}
  1021.  
  1022.     { turn path and name into an ascii zero terminated string }
  1023.     Move(Path[1], FName[0], Length(Path));
  1024.     FName[Length(Path)] := Chr(0);
  1025.  
  1026.     Repeat
  1027.       Status := Btrv(bCreate, PosBlock, Buff, BufSize, FName, Mode);
  1028.     Until (not Error(Status, bCreate, Path));
  1029.   end;
  1030.  
  1031. {+--------------------------------------------------------------------------+}
  1032. {| Name       : Recover                                                     |}
  1033. {| Class      : BtrieveFile                                                 |}
  1034. {| Purpose    : Read records and write to a new file.                       |}
  1035. {| Parameters : NewFilePath - File path name of new file                    |}
  1036. {|              DisplayObj  - pointer to a object that can display progress |}
  1037. {| Returns    : Integer - zero if sucessful                                 |}
  1038. {| Notes      : Reads in Read Only mode and writes to new file.             |}
  1039. {+--------------------------------------------------------------------------+}
  1040. Function BtrieveFile.Recover(NewFilePath : PathStr;
  1041.                              DisplayObj  : PProgress): Integer;
  1042.  
  1043.   var
  1044.     OutFile : BtrieveFile;
  1045.     X       : Byte;
  1046.     Total   : LongInt;
  1047.  
  1048.   begin
  1049.     if (Path = NewFilePath) then
  1050.     begin
  1051.       Recover := bDuplicateFilename;
  1052.       EXIT;
  1053.     end;
  1054.  
  1055.     Clone(NewFilePath, bNoOverWrite);
  1056.  
  1057.     if (Status <> bOkay) then
  1058.     begin
  1059.       Recover := Status;
  1060.       EXIT;
  1061.     end;
  1062.  
  1063.     OutFile.Init(NewFilePath, ErrHandler, Data, DataSize);
  1064.     OutFile.Open(bAccelerated, '');
  1065.  
  1066.     {$IFNDEF BTRIEVE50}
  1067.     Get(bStepNext, bNoLock);
  1068.     {$ELSE}
  1069.     Get(bStepFirst, bNoLock);
  1070.     {$ENDIF}
  1071.     X     := 0;
  1072.     Total := 0;
  1073.  
  1074.     While (Status <> bEOF) and (OutFile.bResult = bOkay) do
  1075.     begin
  1076.       if (Status = bOkay) then
  1077.       begin
  1078.         OutFile.Insert;
  1079.         Inc(X);
  1080.         Inc(Total);
  1081.  
  1082.         if (X = 10) then
  1083.         begin
  1084.           if (DisplayObj <> nil) then
  1085.             DisplayObj^.Display(Total);
  1086.  
  1087.           X := 0;
  1088.         end;
  1089.       end;
  1090.  
  1091.       Get(bStepNext, bNoLock);
  1092.     end; {WHILE}
  1093.  
  1094.     if (DisplayObj <> nil) then
  1095.       DisplayObj^.Display(Total);
  1096.  
  1097.     if (Status <> bEOF) then
  1098.       Recover := Status
  1099.     else if (OutFile.bResult <> bOkay) then
  1100.       Recover := OutFile.bResult
  1101.     else
  1102.       Recover := 0;
  1103.  
  1104.     OutFile.Close;
  1105.   end;
  1106.  
  1107. {+--------------------------------------------------------------------------+}
  1108. {| Name       : Save                                                        |}
  1109. {| Class      : BtrieveFile                                                 |}
  1110. {| Purpose    : Save records to a DOS file.                                 |}
  1111. {| Parameters : NewFilePath - File path name of new file                    |}
  1112. {|              DisplayObj  - pointer to a object that can display progress |}
  1113. {| Returns    : Integer - zero if sucessful                                 |}
  1114. {| Notes      : Writes records to a DOS file. The file will be in the same  |}
  1115. {|              format that the BUTIL RECOVER utility creates.              |}
  1116. {+--------------------------------------------------------------------------+}
  1117. Function BtrieveFile.Save(NewFilePath : PathStr;
  1118.                           DisplayObj  : PProgress): Integer;
  1119.  
  1120.   var
  1121.     X       : Byte;
  1122.     Err     : Integer;
  1123.     Total   : LongInt;
  1124.     St      : String[6];
  1125.     OutFile : File;
  1126.  
  1127.   begin
  1128.     if (Path = NewFilePath) then
  1129.     begin
  1130.       Save := bDuplicateFilename;
  1131.       EXIT;
  1132.     end;
  1133.  
  1134.     {$I-}
  1135.     Assign(OutFile, NewFilePath);
  1136.     ReWrite(OutFile, 1);
  1137.     Err := IoResult;
  1138.  
  1139.     {$IFNDEF BTRIEVE50}
  1140.     Get(bStepNext, bNoLock);
  1141.     {$ELSE}
  1142.     Get(bStepFirst, bNoLock);
  1143.     {$ENDIF}
  1144.     X     := 0;
  1145.     Total := 0;
  1146.  
  1147.     While (Status <> bEOF) and (Err = 0) do
  1148.     begin
  1149.       if (Status = bOkay) then
  1150.       begin
  1151.         Str(BytesRead, St);
  1152.         St := St + ',';
  1153.         BlockWrite(OutFile, St[1], Length(St));
  1154.         Err := IoResult;
  1155.  
  1156.         if (Err = 0) then
  1157.         begin
  1158.           BlockWrite(OutFile, Data^, BytesRead);
  1159.           Err := IoResult;
  1160.         end;
  1161.  
  1162.         if (Err = 0) then
  1163.         begin
  1164.           St := #13#10;
  1165.           BlockWrite(OutFile, St[1], 2);
  1166.           Err := IoResult;
  1167.           Inc(Total);
  1168.           Inc(X);
  1169.  
  1170.           if (X = 10) then
  1171.           begin
  1172.             if (DisplayObj <> nil) then
  1173.               DisplayObj^.Display(Total);
  1174.  
  1175.             X := 0;
  1176.           end;
  1177.         end;
  1178.       end;
  1179.  
  1180.       Get(bStepNext, bNoLock);
  1181.     end; {WHILE}
  1182.  
  1183.     St := #26;
  1184.     BlockWrite(OutFile, St[1], 1);
  1185.  
  1186.     if (DisplayObj <> nil) then
  1187.       DisplayObj^.Display(Total);
  1188.  
  1189.     if (Err = 0) then
  1190.       Err := IoResult;
  1191.  
  1192.     if (Status <> bEOF) then
  1193.       Save := Status
  1194.     else if (Err <> 0) then
  1195.       Save := Err
  1196.     else
  1197.       Save := 0;
  1198.  
  1199.     System.Close(OutFile);
  1200.     {$I+}
  1201.   end;
  1202.  
  1203. {+--------------------------------------------------------------------------+}
  1204. {| Name       : Load                                                        |}
  1205. {| Class      : BtrieveFile                                                 |}
  1206. {| Purpose    : Load records from a DOS file.                               |}
  1207. {| Parameters : InputFilePath - File path name of new file                  |}
  1208. {|              DisplayObj  - pointer to a object that can display progress |}
  1209. {| Returns    : Integer - zero if sucessful                                 |}
  1210. {| Notes      : Reads records from a DOS file and inserts. The file must be |}
  1211. {|              in the same format that the BUTIL RECOVER utility creates.  |}
  1212. {+--------------------------------------------------------------------------+}
  1213. Function BtrieveFile.Load(InputFilePath : PathStr;
  1214.                           DisplayObj    : PProgress): Integer;
  1215.  
  1216.   var
  1217.     X       : Byte;
  1218.     Ch      : Char;
  1219.     Err     : Integer;
  1220.     Size    : Word;
  1221.     Total   : LongInt;
  1222.     St      : String[5];
  1223.     InFile  : File;
  1224.     Buff    : Pointer;
  1225.  
  1226.   begin
  1227.     GetMem(Buff, $FFF0);  {Get max buffer size of 64K}
  1228.  
  1229.     if (Buff = nil) then
  1230.     begin
  1231.       Load := bOutOfMemory;
  1232.       EXIT;
  1233.     end;
  1234.  
  1235.     {$I-}
  1236.     Assign(InFile, InputFilePath);
  1237.     System.Reset(InFile, 1);
  1238.     Err   := IoResult;
  1239.     X     := 0;
  1240.     Total := 0;
  1241.  
  1242.     While (Status = bOkay) and (Err = 0) and not EOF(InFile) do
  1243.     begin
  1244.       BlockRead(InFile, Ch, 1);
  1245.       Err := IoResult;
  1246.       St := '';
  1247.  
  1248.       While (Ch <> ',') and (Ch <> ' ') and (Ch <> #26) and (Err = 0) do
  1249.       begin
  1250.         St := St + Ch;
  1251.         BlockRead(InFile, Ch, 1);
  1252.         Err := IoResult;
  1253.       end;
  1254.  
  1255.       if (Err = 0) and (Ch <> #26) then
  1256.       begin
  1257.         Val(St, Size, Err);
  1258.  
  1259.         if (Err <> 0) then
  1260.         begin
  1261.           Load := bLoadInputErr;
  1262.           EXIT;
  1263.         end
  1264.  
  1265.         else
  1266.         begin
  1267.           BlockRead(InFile, Buff^, Size);
  1268.           Err := IoResult;
  1269.  
  1270.           if (Err = 0) then
  1271.           begin
  1272.             BlockRead(InFile, St, 2);
  1273.             Err := IoResult;
  1274.           end;
  1275.  
  1276.           if not VariableLen and (Size > DataSize) then
  1277.             Size := DataSize;
  1278.  
  1279.           Move(Buff^, Data^, Size);
  1280.           SetOutputSize(Size);
  1281.           Insert;
  1282.           Inc(X);
  1283.           Inc(Total);
  1284.  
  1285.           if (X = 10) then
  1286.           begin
  1287.             if (DisplayObj <> nil) then
  1288.               DisplayObj^.Display(Total);
  1289.  
  1290.             X := 0;
  1291.           end;
  1292.         end;
  1293.       end;
  1294.     end; {WHILE}
  1295.  
  1296.     if (DisplayObj <> nil) then
  1297.       DisplayObj^.Display(Total);
  1298.  
  1299.     if (Status <> bOkay) then
  1300.       Load := Status
  1301.     else if (Err <> 0) then
  1302.       Load := Err
  1303.     else
  1304.       Load := 0;
  1305.  
  1306.     System.Close(InFile);
  1307.     {$I+}
  1308.   end;
  1309.  
  1310. {+--------------------------------------------------------------------------+}
  1311. {| Name       : Clone                                                       |}
  1312. {| Class      : BtrieveFile                                                 |}
  1313. {| Purpose    : Clone a file from an existing file.                         |}
  1314. {| Parameters : NewFilePath - File path name new file                       |}
  1315. {|              Mode        - indicates overwrite or warn mode              |}
  1316. {| Returns    : none                                                        |}
  1317. {+--------------------------------------------------------------------------+}
  1318. Procedure BtrieveFile.Clone(NewFilePath : PathStr;
  1319.                             Mode        : Integer);
  1320.  
  1321.   var
  1322.     FName : Array[0..SizeOf(PathStr) - 1] of Char;
  1323.     FData : FileSpec;
  1324.     PBlock: Array[1..PosBlockSize] of Byte;
  1325.  
  1326.   begin
  1327.     if (Path = NewFilePath) then
  1328.     begin
  1329.       Status := bDuplicateFilename;
  1330.       EXIT;
  1331.     end;
  1332.  
  1333.     Stat(FData);
  1334.     { turn pathname into an ascii zero terminated string }
  1335.     Move(NewFilePath[1], FName[0], Length(NewFilePath));
  1336.     FName[Length(NewFilePath)] := Chr(0);
  1337.  
  1338.     Repeat
  1339.       Status := Btrv(bCreate, PBlock, FData, BytesRead, FName, Mode);
  1340.     Until (not Error(Status, bCreate, NewFilePath));
  1341.   end;
  1342.  
  1343. {+--------------------------------------------------------------------------+}
  1344. {| Name       : AddSupplKeySegment                                          |}
  1345. {| Class      : BtrieveFile                                                 |}
  1346. {| Purpose    : Define the next key segment for a supplemental index.       |}
  1347. {| Parameters : Position - where it starts in the key                       |}
  1348. {|              Size     - number of bytes in this segment                  |}
  1349. {|              Flags    - btrieve file flags                               |}
  1350. {|              KeyType  - btrieve key type                                 |}
  1351. {|              NullValue- null value for this segment                      |}
  1352. {|              Justify  - Applies to lStrings only.                        |}
  1353. {|                         0 for the string to be left as is.               |}
  1354. {|                         1 for the string to be right justified.          |}
  1355. {|                         2 for the string to be left justified.           |}
  1356. {| Returns    : none                                                        |}
  1357. {| Notes      : Segments must be defined in order.                          |}
  1358. {+--------------------------------------------------------------------------+}
  1359. Procedure BtrieveFile.AddSupplKeySegment(Position  : Word;
  1360.                                          Size      : Word;
  1361.                                          Flags     : Word;
  1362.                                          KeyType   : Byte;
  1363.                                          NullValue : Byte;
  1364.                                          Justify   : Byte);
  1365.   begin
  1366.     { if more segments are allowed  }
  1367.     if (SegmentCnt + SISegments < MaxSegments) then
  1368.     begin
  1369.       { increase the current key size by the size of this segment }
  1370.       CurrentKeySize := CurrentKeySize + Size;
  1371.  
  1372.       Inc(SISegments);
  1373.  
  1374.       { if this is the first segment in the current key
  1375.         then add to list of key starting segments
  1376.       }
  1377.       if (KeyStart[IndexCnt] = 0) then
  1378.         KeyStart[IndexCnt] := SegmentCnt + 1;
  1379.  
  1380.       { add it to the list of key definitions }
  1381.       KeyList[SegmentCnt + SISegments].KeyPos    := Position;
  1382.       KeyList[SegmentCnt + SISegments].KeyLen    := Size;
  1383.       KeyList[SegmentCnt + SISegments].KeyFlags  := Flags;
  1384.       KeyList[SegmentCnt + SISegments].KeyType   := KeyType;
  1385.       KeyList[SegmentCnt + SISegments].NullValue := NullValue;
  1386.       KeyList[SegmentCnt + SISegments].Justify   := Justify;
  1387.     end;
  1388.   end;
  1389.  
  1390. {+--------------------------------------------------------------------------+}
  1391. {| Name       : CreateIndex                                                 |}
  1392. {| Class      : BtrieveFile                                                 |}
  1393. {| Purpose    : Create a supplemental index for the file.                   |}
  1394. {| Parameters : none                                                        |}
  1395. {| Returns    : none                                                        |}
  1396. {+--------------------------------------------------------------------------+}
  1397. Procedure BtrieveFile.CreateIndex;
  1398.  
  1399.   var
  1400.     i       : Integer;
  1401.     BufSize : Word;
  1402.     Buff    : KeySpecArray;
  1403.     Temp    : Array[1..1024] of Byte Absolute Buff;
  1404.     AltFile : File;
  1405.  
  1406.   begin
  1407.     { move all the key defs to the data buffer  }
  1408.     for i := 1 to SISegments do
  1409.     begin
  1410.       Buff[i].KeyPos    := KeyList[i + SegmentCnt].KeyPos;
  1411.       Buff[i].KeyLen    := KeyList[i + SegmentCnt].KeyLen;
  1412.       Buff[i].KeyFlags  := KeyList[i + SegmentCnt].KeyFlags;
  1413.       Buff[i].KeyType   := KeyList[i + SegmentCnt].KeyType;
  1414.       Buff[i].NullValue := KeyList[i + SegmentCnt].NullValue;
  1415.     end;
  1416.  
  1417.     { calculate the buffer size so far                    }
  1418.     {       Segments * Segment data size + file data size }
  1419.     BufSize := SISegments * SizeOf(KeySpec);
  1420.  
  1421.     { read the alternate collating sequence if any        }
  1422.     {$I-}
  1423.     if (AltPath <> '') then
  1424.     begin
  1425.       System.Assign(AltFile, AltPath);
  1426.       System.Reset(AltFile, 1);
  1427.  
  1428.       if (IoResult = 0) then
  1429.       begin
  1430.         System.BlockRead(AltFile, Temp[BufSize+1], 265);{ Read file   }
  1431.         System.Close(AltFile);
  1432.         BufSize := BufSize + 265;
  1433.         i := IoResult;
  1434.       end;
  1435.     end;
  1436.     {$I+}
  1437.  
  1438.     Repeat
  1439.       Status := Btrv(bCreateIndex, PosBlock, Buff, BufSize, i, i);
  1440.     Until (not Error(Status, bCreateIndex, Path));
  1441.  
  1442.     if (Status = bOkay) then
  1443.     begin
  1444.       { bump the number of keys and segments }
  1445.       Inc(IndexCnt);
  1446.       Inc(SegmentCnt, SISegments);
  1447.  
  1448.       { resize the key buffer }
  1449.       if (CurrentKeySize > KeySize) then
  1450.       begin
  1451.         FreeMem(Key, KeySize);
  1452.         KeySize := CurrentKeySize;
  1453.         CurrentKeySize := 0;
  1454.         GetMem(Key, KeySize);
  1455.  
  1456.         if ((Key = nil) and (KeySize > 0)) then
  1457.         begin
  1458.           Status := bOutOfMemory;
  1459.           Error(Status, bCreateIndex, Path);
  1460.         end;
  1461.       end;
  1462.     end;
  1463.   end;
  1464.  
  1465. {+--------------------------------------------------------------------------+}
  1466. {| Name       : DropIndex                                                   |}
  1467. {| Class      : BtrieveFile                                                 |}
  1468. {| Purpose    : Drop a supplemental index from the file.                    |}
  1469. {| Parameters : none                                                        |}
  1470. {| Returns    : none                                                        |}
  1471. {+--------------------------------------------------------------------------+}
  1472. Procedure BtrieveFile.DropIndex(Index : Integer);
  1473.  
  1474.   var
  1475.     I : Integer;
  1476.     W : Word;
  1477.  
  1478.   begin
  1479.     Repeat
  1480.       Status := Btrv(bDropIndex, PosBlock, I, W, I, Index);
  1481.     Until (not Error(Status, bDropIndex, Path));
  1482.   end;
  1483.  
  1484. {+--------------------------------------------------------------------------+}
  1485. {| Name       : ChangeBufferSize                                            |}
  1486. {| Class      : BtrieveFile                                                 |}
  1487. {| Purpose    : Change the size of the data buffer.                         |}
  1488. {| Parameters : Size  - new buffer size                                     |}
  1489. {| Returns    : none                                                        |}
  1490. {| Notes      : ONLY valid for objects that allocated buffer memory.        |}
  1491. {+--------------------------------------------------------------------------+}
  1492. Procedure BtrieveFile.ChangeBufferSize(Size : Word);
  1493.   begin
  1494.     if (Size = DataSize) then EXIT;
  1495.  
  1496.     if (Size > MaxAvail) then
  1497.       Size := MaxAvail;
  1498.  
  1499.     if (Data <> nil) then
  1500.       FreeMem(Data, DataSize);
  1501.  
  1502.     DataSize := Size;
  1503.     GetMem(Data, DataSize);
  1504.  
  1505.     if ((Data = nil) and (DataSize > 0)) then
  1506.     begin
  1507.       Status := bOutOfMemory;
  1508.       Error(Status, 0, Path);
  1509.     end;
  1510.   end;
  1511.  
  1512. {+--------------------------------------------------------------------------+}
  1513. {| Name       : SetOwner                                                    |}
  1514. {| Class      : BtrieveFile                                                 |}
  1515. {| Purpose    : Set the owner name and access mode for the file.            |}
  1516. {| Parameters : Owner - up to 8 character owner name                        |}
  1517. {|              Mode  - Access mode for file                                |}
  1518. {| Returns    : none                                                        |}
  1519. {+--------------------------------------------------------------------------+}
  1520. Procedure BtrieveFile.SetOwner(Owner : String;
  1521.                                Mode  : Integer);
  1522.  
  1523.   var
  1524.     BufSize : Word;
  1525.     Buff    : Array[1..9] of Char;
  1526.  
  1527.   begin
  1528.     Trim(Owner);
  1529.  
  1530.     if (Owner = '') then EXIT;
  1531.  
  1532.     FillChar(Buff, SizeOf(Buff), 0);
  1533.     BufSize := Length(Owner);
  1534.  
  1535.     if (BufSize > 8) then
  1536.       BufSize := 8;
  1537.  
  1538.     Move(Owner[1], Buff[1], BufSize);
  1539.  
  1540.     Repeat
  1541.       Status := Btrv(bSetOwner, PosBlock, Buff, BufSize, Buff, Mode);
  1542.     Until (not Error(Status, bSetOwner, Path));
  1543.   end;
  1544.  
  1545. {+--------------------------------------------------------------------------+}
  1546. {| Name       : ClearOwner                                                  |}
  1547. {| Class      : BtrieveFile                                                 |}
  1548. {| Purpose    : Clear the owner name and access mode for the file.          |}
  1549. {| Parameters : none                                                        |}
  1550. {| Returns    : none                                                        |}
  1551. {+--------------------------------------------------------------------------+}
  1552. Procedure BtrieveFile.ClearOwner;
  1553.  
  1554.   var
  1555.     I : Integer;
  1556.     W : Word;
  1557.  
  1558.   begin
  1559.     Repeat
  1560.       Status := Btrv(bClearOwner, PosBlock, I, W, I, I);
  1561.     Until (not Error(Status, bClearOwner, Path));
  1562.   end;
  1563.  
  1564. {+--------------------------------------------------------------------------+}
  1565. {| Name       : Close                                                       |}
  1566. {| Class      : BtrieveFile                                                 |}
  1567. {| Purpose    : Close a btrieve file                                        |}
  1568. {| Parameters : none                                                        |}
  1569. {| Returns    : none                                                        |}
  1570. {| Notes      : Call Done to destroy the object and free memory.            |}
  1571. {+--------------------------------------------------------------------------+}
  1572. Procedure BtrieveFile.Close;
  1573.  
  1574.   var
  1575.     I : Integer;
  1576.     W : Word;
  1577.  
  1578.   begin
  1579.     if FileOpen then
  1580.     begin
  1581.       Repeat
  1582.         Status := Btrv(bClose, PosBlock, I, W, I, 0);
  1583.       Until (not Error(Status, bClose, Path));
  1584.  
  1585.       FileOpen := not (Status = bOkay);
  1586.     end;
  1587.   end;
  1588.  
  1589. {+--------------------------------------------------------------------------+}
  1590. {| Name       : Error                                                       |}
  1591. {| Class      : BtrieveFile                                                 |}
  1592. {| Purpose    : Call the error handler object.                              |}
  1593. {| Parameters : Status    - the last btrieve status code                    |}
  1594. {|              OpCode    - btrieve operation that generate error           |}
  1595. {|              FileName  - file the error occured with                     |}
  1596. {| Returns    : TRUE as long as there is still an error.                    |}
  1597. {| Notes      : If an error handler object has not been assigned this will  |}
  1598. {|              always return FALSE.                                        |}
  1599. {+--------------------------------------------------------------------------+}
  1600. Function BtrieveFile.Error(ErrStatus: Integer;
  1601.                            OpCode   : Byte;
  1602.                            FileName : PathStr
  1603.                            ): Boolean;
  1604.   begin
  1605.     if (ErrHandler <> nil) then
  1606.       Error := ErrHandler^.Error(ErrStatus, OpCode, FileName)
  1607.     else
  1608.       Error := False;
  1609.   end;
  1610.  
  1611. {+--------------------------------------------------------------------------+}
  1612. {| Name       : Get                                                         |}
  1613. {| Class      : BtrieveFile                                                 |}
  1614. {| Purpose    : Read a record                                               |}
  1615. {| Parameters : Op   - type of read operation                               |}
  1616. {|              Lock - type of lock                                         |}
  1617. {| Returns    : none                                                        |}
  1618. {+--------------------------------------------------------------------------+}
  1619. Procedure BtrieveFile.Get(Op   : Word;
  1620.                           Lock : Word);
  1621.   begin
  1622.     BytesRead := DataSize;
  1623.  
  1624.     Repeat
  1625.       Status := Btrv(Op + Lock, PosBlock, Data^, BytesRead, Key^, CurIndex);
  1626.     Until (not Error(Status, Op, Path));
  1627.   end;
  1628.  
  1629. {+--------------------------------------------------------------------------+}
  1630. {| Name       : GetDirect                                                   |}
  1631. {| Class      : BtrieveFile                                                 |}
  1632. {| Purpose    : Read a record at a speific file position                    |}
  1633. {| Parameters : Lock - type of lock                                         |}
  1634. {|              Position - record position in the file as returned by       |}
  1635. {|                         a call to GetPosition.                           |}
  1636. {| Returns    : none                                                        |}
  1637. {| Notes      : Establishes index position for current key path.            |}
  1638. {+--------------------------------------------------------------------------+}
  1639. Procedure BtrieveFile.GetDirect(Lock     : Word;
  1640.                                 Position : LongInt);
  1641.  
  1642.   begin
  1643.     BytesRead := DataSize;
  1644.     Move(Position, Data^, 4);
  1645.  
  1646.     Repeat
  1647.       Status := Btrv(bGetDirect + Lock, PosBlock, Data^, BytesRead, Key^, CurIndex);
  1648.     Until (not Error(Status, bGetDirect, Path));
  1649.   end;
  1650.  
  1651. {+--------------------------------------------------------------------------+}
  1652. {| Name       : Insert                                                      |}
  1653. {| Class      : BtrieveFile                                                 |}
  1654. {| Purpose    : Add a new record to the file                                |}
  1655. {| Parameters : none                                                        |}
  1656. {| Returns    : none                                                        |}
  1657. {| Notes      : Automatically pads or right justifies key strings.          |}
  1658. {|              When writing variable length records make sure to set the   |}
  1659. {|              output buffer size.                                         |}
  1660. {+--------------------------------------------------------------------------+}
  1661. Procedure BtrieveFile.Insert;
  1662.   begin
  1663.     FixKeyStrings;
  1664.  
  1665.     Repeat
  1666.       Status := Btrv(bInsert, PosBlock, Data^, BytesToWrite, Key^, CurIndex);
  1667.     Until (not Error(Status, bInsert, Path));
  1668.   end;
  1669.  
  1670. {+--------------------------------------------------------------------------+}
  1671. {| Name       : Update                                                      |}
  1672. {| Class      : BtrieveFile                                                 |}
  1673. {| Purpose    : Update an existing record in the file                       |}
  1674. {| Parameters : none                                                        |}
  1675. {| Returns    : none                                                        |}
  1676. {| Notes      : Updates the last record retrieved.                          |}
  1677. {|              Automatically pads or right justifies key strings.          |}
  1678. {|              When writing variable length records make sure to set the   |}
  1679. {|              output buffer size.                                         |}
  1680. {+--------------------------------------------------------------------------+}
  1681. Procedure BtrieveFile.Update;
  1682.   begin
  1683.     FixKeyStrings;
  1684.  
  1685.     Repeat
  1686.       Status := Btrv(bUpdate, PosBlock, Data^, BytesToWrite, Key^, CurIndex);
  1687.     Until (not Error(Status, bUpdate, Path));
  1688.   end;
  1689.  
  1690. {+--------------------------------------------------------------------------+}
  1691. {| Name       : Delete                                                      |}
  1692. {| Class      : BtrieveFile                                                 |}
  1693. {| Purpose    : Delete a record                                             |}
  1694. {| Parameters : none                                                        |}
  1695. {| Returns    : none                                                        |}
  1696. {| Notes      : Deletes the current record, i.e. last record retrieved.     |}
  1697. {+--------------------------------------------------------------------------+}
  1698. Procedure BtrieveFile.Delete;
  1699.  
  1700.   var
  1701.     I : Integer;
  1702.  
  1703.   begin
  1704.     BytesRead := DataSize;
  1705.  
  1706.     Repeat
  1707.       Status := Btrv(bDelete, PosBlock, I, BytesRead, I, 0);
  1708.     Until (not Error(Status, bDelete, Path));
  1709.  
  1710.     BytesRead := 0;
  1711.   end;
  1712.  
  1713. {+--------------------------------------------------------------------------+}
  1714. {| Name       : GetPosition                                                 |}
  1715. {| Class      : BtrieveFile                                                 |}
  1716. {| Purpose    : Get the physical file position of a record                  |}
  1717. {| Parameters : none                                                        |}
  1718. {| Returns    : Returns the position of the last record retrieved.          |}
  1719. {|              Returns a -1 if any error occurs.                           |}
  1720. {+--------------------------------------------------------------------------+}
  1721. Function BtrieveFile.GetPosition: LongInt;
  1722.  
  1723.   var
  1724.     I       : Integer;
  1725.     Pos     : LongInt;
  1726.     BufSize : Word;
  1727.  
  1728.   begin
  1729.     BufSize := 4;
  1730.  
  1731.     Repeat
  1732.       Status := Btrv(bGetPosition, PosBlock, Pos, BufSize, I, 0);
  1733.     Until (not Error(Status, bGetPosition, Path));
  1734.  
  1735.     if (Status = bOkay) then
  1736.       GetPosition := Pos
  1737.     else
  1738.       GetPosition := -1;
  1739.   end;
  1740.  
  1741. {+--------------------------------------------------------------------------+}
  1742. {| Name       : UnlockAll                                                   |}
  1743. {| Class      : BtrieveFile                                                 |}
  1744. {| Purpose    : Unlock all records in the file.                             |}
  1745. {| Parameters : Lock - if <= 200 then single locks are active               |}
  1746. {|                     if > 200 then multiple locks are active              |}
  1747. {| Returns    : none                                                        |}
  1748. {+--------------------------------------------------------------------------+}
  1749. Procedure BtrieveFile.UnlockAll(Lock : Word);
  1750.  
  1751.   var
  1752.     I     : Integer;
  1753.     W     : Word;
  1754.     KeyNum: Integer;
  1755.  
  1756.   begin
  1757.     if (Lock <= bSingleNoWait) then
  1758.       KeyNum := 1
  1759.     else
  1760.       KeyNum := -2;
  1761.  
  1762.     Repeat
  1763.       Status := Btrv(bUnlock, PosBlock, I, W, I, KeyNum);
  1764.     Until (not Error(Status, bUnlock, Path));
  1765.   end;
  1766.  
  1767. {+--------------------------------------------------------------------------+}
  1768. {| Name       : AddError                                                    |}
  1769. {| Class      : BtrieveFile                                                 |}
  1770. {| Purpose    : Add an error to the trapped error set                       |}
  1771. {| Parameters : ErrorCode - btrieve status code to add                      |}
  1772. {| Returns    : none                                                        |}
  1773. {| Notes      : All errors except bEOF are trapped by default               |}
  1774. {+--------------------------------------------------------------------------+}
  1775. Procedure BtrieveFile.AddErrors(ErrorCodes : ErrorSet);
  1776.   begin
  1777.     if (ErrHandler <> nil) then
  1778.       ErrHandler^.AddErrors(ErrorCodes);
  1779.   end;
  1780.  
  1781. {+--------------------------------------------------------------------------+}
  1782. {| Name       : RemoveError                                                 |}
  1783. {| Class      : BtrieveFile                                                 |}
  1784. {| Purpose    : Remove a error form the trapped errors                      |}
  1785. {| Parameters : ErrorCode - btrieve status code to remove                   |}
  1786. {| Parameters : none                                                        |}
  1787. {| Returns    : none                                                        |}
  1788. {| Notes      : bOkay will not be removed.                                  |}
  1789. {|              All errors except bEOF are trapped by default               |}
  1790. {+--------------------------------------------------------------------------+}
  1791. Procedure BtrieveFile.RemoveErrors(ErrorCodes : ErrorSet);
  1792.   begin
  1793.     if (ErrHandler <> nil) then
  1794.       ErrHandler^.RemoveErrors(ErrorCodes);
  1795.   end;
  1796.  
  1797. {+--------------------------------------------------------------------------+}
  1798. {| Name       : SetErrors                                                   |}
  1799. {| Class      : BtrieveFile                                                 |}
  1800. {| Purpose    : Make the set of all trapped errors.                         |}
  1801. {| Parameters : ErrorCodes - A set of btrieve status codes to become the new|}
  1802. {|                           trapped error set.                             |}
  1803. {| Returns    : none                                                        |}
  1804. {+--------------------------------------------------------------------------+}
  1805. Procedure BtrieveFile.SetErrors(ErrorCodes : ErrorSet);
  1806.   begin
  1807.     if (ErrHandler <> nil) then
  1808.       ErrHandler^.SetErrors(ErrorCodes);
  1809.   end;
  1810.  
  1811. {+--------------------------------------------------------------------------+}
  1812. {| Name       : GetErrors                                                   |}
  1813. {| Class      : BtrieveFile                                                 |}
  1814. {| Purpose    : Return the set of all trapped errors.                       |}
  1815. {| Parameters : ErrorCodes - The set of btrieve status codes currently      |}
  1816. {|              trapped.                                                    |}
  1817. {| Returns    : none                                                        |}
  1818. {+--------------------------------------------------------------------------+}
  1819. Procedure BtrieveFile.GetErrors(var ErrorCodes : ErrorSet);
  1820.   begin
  1821.     if (ErrHandler <> nil) then
  1822.       ErrHandler^.GetErrors(ErrorCodes)
  1823.     else
  1824.       ErrorCodes := [];
  1825.   end;
  1826.  
  1827. {+--------------------------------------------------------------------------+}
  1828. {| Name       : ClearBuffer                                                 |}
  1829. {| Class      : BtrieveFile                                                 |}
  1830. {| Purpose    : Fill the file data buffer with zeros.                       |}
  1831. {| Parameters : none                                                        |}
  1832. {| Returns    : none                                                        |}
  1833. {| Notes      : Use this to clear the buffer before you add new records.    |}
  1834. {+--------------------------------------------------------------------------+}
  1835. Procedure BtrieveFile.ClearBuffer;
  1836.   begin
  1837.     FillChar(Data^, DataSize, 0);
  1838.     BytesRead := 0;
  1839.   end;
  1840.  
  1841. {+--------------------------------------------------------------------------+}
  1842. {| Name       : SetOutputSize                                               |}
  1843. {| Class      : BtrieveFile                                                 |}
  1844. {| Purpose    : Set the number of bytes in the output buffer.               |}
  1845. {|              This is used to set the buffer size before writing a        |}
  1846. {|              variable length record.                                     |}
  1847. {| Parameters : Size - number of bytes in the output buffer                 |}
  1848. {| Returns    : none                                                        |}
  1849. {+--------------------------------------------------------------------------+}
  1850. Procedure BtrieveFile.SetOutputSize(Size : Word);
  1851.   begin
  1852.     BytesToWrite := Size;
  1853.   end;
  1854.  
  1855. {+--------------------------------------------------------------------------+}
  1856. {| Name       : ClearKey                                                    |}
  1857. {| Class      : BtrieveFile                                                 |}
  1858. {| Purpose    : Fill the file key buffer with zeros.                        |}
  1859. {| Parameters : none                                                        |}
  1860. {| Returns    : none                                                        |}
  1861. {+--------------------------------------------------------------------------+}
  1862. Procedure BtrieveFile.ClearKey;
  1863.   begin
  1864.     FillChar(Key^, KeySize, 0);
  1865.   end;
  1866.  
  1867. {+--------------------------------------------------------------------------+}
  1868. {| Name       : FillKeyBuffer                                               |}
  1869. {| Class      : BtrieveFile                                                 |}
  1870. {| Purpose    : Fill the file key buffer with with supplied data.           |}
  1871. {| Parameters : Buff - some data to move into the key buffer                |}
  1872. {|              Size - how much data to move into the key buffer            |}
  1873. {| Returns    : none                                                        |}
  1874. {+--------------------------------------------------------------------------+}
  1875. Procedure BtrieveFile.FillKeyBuffer(var Buff; Size : Byte);
  1876.   begin
  1877.     if (Size > KeySize) then
  1878.       Size := KeySize;
  1879.  
  1880.     ClearKey;
  1881.     Move(Buff, Key^, Size);
  1882.   end;
  1883.  
  1884. {+--------------------------------------------------------------------------+}
  1885. {| Name       : MakeKey                                                     |}
  1886. {| Class      : BtrieveFile                                                 |}
  1887. {| Purpose    : Build a key for reading a record from the file.             |}
  1888. {| Parameters : KeyNumber - Which path are we building for.                 |}
  1889. {|              V1..V6    - Pointers to the data to make into a file key.   |}
  1890. {| Returns    : none                                                        |}
  1891. {| Notes      : Make sure to pass the addresses in the correct order for the|}
  1892. {|              specified path. This routine will left or right justify     |}
  1893. {|              strings as defined by AddKeySegment. Pass unused pointers as|}
  1894. {|              nil.                                                        |}
  1895. {+--------------------------------------------------------------------------+}
  1896. Procedure BtrieveFile.MakeKey(V1 : Pointer;
  1897.                               V2 : Pointer;
  1898.                               V3 : Pointer;
  1899.                               V4 : Pointer;
  1900.                               V5 : Pointer;
  1901.                               V6 : Pointer);
  1902.  
  1903.   var
  1904.     ParamPtr  : Pointer;
  1905.     Param     : Byte;
  1906.     KeyPos    : Byte;
  1907.     SegIndex  : Byte;
  1908.     Segmented : Word;
  1909.     St        : String;
  1910.     x         : Byte;
  1911.  
  1912.   begin
  1913.     { clear the key buffer }
  1914.     FillChar(Key^, KeySize, 0);
  1915.     { init the key buffer offset, the current parameter number, }
  1916.     { and the offset into the list of key segment definitions   }
  1917.     KeyPos  := 1;
  1918.     Param   := 1;
  1919.     SegIndex:= KeyStart[CurIndex];
  1920.  
  1921.     Repeat
  1922.       { point to the current parameter }
  1923.       Case Param of
  1924.         1 : ParamPtr := V1;
  1925.         2 : ParamPtr := V2;
  1926.         3 : ParamPtr := V3;
  1927.         4 : ParamPtr := V4;
  1928.         5 : ParamPtr := V5;
  1929.         6 : ParamPtr := V6;
  1930.       end;
  1931.  
  1932.       { pascal strings get some special processing }
  1933.       Case KeyList[SegIndex].KeyType of
  1934.         bLstring :
  1935.         begin
  1936.           St := String(ParamPtr^);
  1937.  
  1938.           Case KeyList[SegIndex].Justify of
  1939.             bRJustify :
  1940.             begin
  1941.               Trim(St);
  1942.               LeftPad(St, KeyList[SegIndex].KeyLen - 1)
  1943.             end;
  1944.  
  1945.             bLJustify :
  1946.             begin
  1947.               Trim(St);
  1948.               Pad(St, KeyList[SegIndex].KeyLen - 1);
  1949.             end;
  1950.           end; {CASE}
  1951.  
  1952.           Move(St[0], PBytes(Key)^[KeyPos], KeyList[SegIndex].KeyLen);
  1953.         end;
  1954.  
  1955.         { just copy everything else over to the key buffer }
  1956.         else
  1957.         begin
  1958.           Move(ParamPtr^, PBytes(Key)^[KeyPos], KeyList[SegIndex].KeyLen);
  1959.         end; {CASE ELSE}
  1960.       end; {CASE}
  1961.  
  1962.       { get the value of the segment bit from the key def }
  1963.       Segmented := KeyList[SegIndex].KeyFlags AND bSegmented;
  1964.       { bump the position in the key buffer }
  1965.       KeyPos    := KeyPos + KeyList[SegIndex].KeyLen;
  1966.       { move to next segment and parameter }
  1967.       Inc(SegIndex);
  1968.       Inc(Param);
  1969.     Until (Segmented = 0);  { we have copied the last segment }
  1970.   end;
  1971.  
  1972. {+--------------------------------------------------------------------------+}
  1973. {| Name       : FixKeyStrings                                               |}
  1974. {| Class      : BtrieveFile                                                 |}
  1975. {| Purpose    : Left or right justify all key string fields as needed.      |}
  1976. {| Parameters : none                                                        |}
  1977. {| Returns    : none                                                        |}
  1978. {+--------------------------------------------------------------------------+}
  1979. Procedure BtrieveFile.FixKeyStrings;
  1980.  
  1981.   var
  1982.     i   : Byte;
  1983.     St  : String;
  1984.  
  1985.   begin
  1986.     { proccess all key segments }
  1987.     for i := 1 to SegmentCnt do
  1988.     begin
  1989.       { pascal strings get some special processing }
  1990.       Case KeyList[i].KeyType of
  1991.         bLstring :
  1992.         begin
  1993.           { pull it out of the buffer }
  1994.           Move(PBytes(Data)^[KeyList[i].KeyPos], St[0], KeyList[i].KeyLen);
  1995.  
  1996.           Case KeyList[i].Justify of
  1997.             bRJustify :
  1998.             begin
  1999.               Trim(St);
  2000.               LeftPad(St, KeyList[i].KeyLen - 1)
  2001.             end;
  2002.  
  2003.             bLJustify :
  2004.             begin
  2005.               Trim(St);
  2006.               Pad(St, KeyList[i].KeyLen - 1);
  2007.             end;
  2008.           end; {CASE}
  2009.  
  2010.           { put it back in the buffer }
  2011.           Move(St[0], PBytes(Data)^[KeyList[i].KeyPos], KeyList[i].KeyLen);
  2012.         end;
  2013.       end; {CASE}
  2014.     end; {FOR}
  2015.   end;
  2016.  
  2017. {+--------------------------------------------------------------------------+}
  2018. {| Name       : IsOpen                                                      |}
  2019. {| Class      : BtrieveFile                                                 |}
  2020. {| Purpose    : Indicate if the file has been opened.                       |}
  2021. {| Parameters : none                                                        |}
  2022. {| Returns    : Boolean - TRUE if the file is open.                         |}
  2023. {+--------------------------------------------------------------------------+}
  2024. Function BtrieveFile.IsOpen;
  2025.   begin
  2026.     IsOpen := FileOpen;
  2027.   end;
  2028.  
  2029. {+--------------------------------------------------------------------------+}
  2030. {| Name       : NumberOfRecords                                             |}
  2031. {| Class      : BtrieveFile                                                 |}
  2032. {| Purpose    : Get the number of records in the file.                      |}
  2033. {| Parameters : none                                                        |}
  2034. {| Returns    : LongInt - Number of records in the file.                    |}
  2035. {+--------------------------------------------------------------------------+}
  2036. Function BtrieveFile.NumberOfRecords: LongInt;
  2037.  
  2038.   var
  2039.     BufSize : Word;
  2040.     Buffer1 : Array[1..1024] of Byte;
  2041.     Temp    : FileSpec Absolute Buffer1;
  2042.     Buffer2 : Array[1..64] of Byte;
  2043.  
  2044.   begin
  2045.     BufSize := SizeOf(Buffer1);
  2046.  
  2047.     Repeat
  2048.       Status := Btrv(bStat, PosBlock, Buffer1, BufSize, Buffer2, 0);
  2049.     Until (not Error(Status, bStat, Path));
  2050.  
  2051.     if (Status = bOkay) then
  2052.       NumberOfRecords := Temp.Records
  2053.     else
  2054.       NumberOfRecords := -1;
  2055.   end;
  2056.  
  2057. {+--------------------------------------------------------------------------+}
  2058. {| Name       : bResult                                                     |}
  2059. {| Class      : BtrieveFile                                                 |}
  2060. {| Purpose    : Get the status of the file.                                 |}
  2061. {| Parameters : none                                                        |}
  2062. {| Returns    : Integer - Last btrieve error code.                          |}
  2063. {| Notes      : Error is not cleared, so it can be checked multiple times.  |}
  2064. {+--------------------------------------------------------------------------+}
  2065. Function BtrieveFile.bResult: Integer;
  2066.   begin
  2067.     bResult := Status;
  2068.   end;
  2069.  
  2070. {+--------------------------------------------------------------------------+}
  2071. {| Name       : Done                                                        |}
  2072. {| Class      : BtrieveFile                                                 |}
  2073. {| Purpose    : Destroy the object.                                         |}
  2074. {| Parameters : none                                                        |}
  2075. {| Returns    : none                                                        |}
  2076. {+--------------------------------------------------------------------------+}
  2077. Destructor BtrieveFile.Done;
  2078.   begin
  2079.     if (Key <> nil) then
  2080.       FreeMem(Key, KeySize);
  2081.  
  2082.     if Allocate and (Data <> nil) then
  2083.       FreeMem(Data, DataSize);
  2084.   end;
  2085.  
  2086. {+--------------------------------------------------------------------------+}
  2087. {| Name       : StartTransaction                                            |}
  2088. {| Class      : BtrieveFile                                                 |}
  2089. {| Purpose    : Begin a btrieve transaction                                 |}
  2090. {| Parameters : Lock - Locking state for the transaction. By default a value|}
  2091. {|                     of bNoLock will start a transaction that waits on any|}
  2092. {|                     other transactions. Pass bSingleNoWait (200) or      |}
  2093. {|                     bMultipleNoWait (400) for a no wait file lock.       |}
  2094. {| Returns    : none                                                        |}
  2095. {| Notes      : Don't actually need an open file to execute this method.    |}
  2096. {+--------------------------------------------------------------------------+}
  2097. Procedure BtrieveFile.StartTransaction(Lock : Word);
  2098.  
  2099.   var
  2100.     I : Integer;
  2101.     W : Word;
  2102.  
  2103.   begin
  2104.     Repeat
  2105.       Status := Btrv(bBeginTransaction, I, I, W, I, 0);
  2106.     Until (not Error(Status, bBeginTransaction + Lock, Path));
  2107.   end;
  2108.  
  2109. {+--------------------------------------------------------------------------+}
  2110. {| Name       : EndTransaction                                              |}
  2111. {| Class      : BtrieveFile                                                 |}
  2112. {| Purpose    : End a btrieve transaction                                   |}
  2113. {| Parameters : none                                                        |}
  2114. {| Returns    : none                                                        |}
  2115. {| Notes      : Don't actually need an open file to execute this method.    |}
  2116. {+--------------------------------------------------------------------------+}
  2117. Procedure BtrieveFile.EndTransaction;
  2118.  
  2119.   var
  2120.     I : Integer;
  2121.     W : Word;
  2122.  
  2123.   begin
  2124.     Repeat
  2125.       Status := Btrv(bEndTransaction, I, I, W, I, 0);
  2126.     Until (not Error(Status, bEndTransaction, Path));
  2127.   end;
  2128.  
  2129. {+--------------------------------------------------------------------------+}
  2130. {| Name       : AbortTransaction                                            |}
  2131. {| Class      : BtrieveFile                                                 |}
  2132. {| Purpose    : Abort a btrieve transaction                                 |}
  2133. {| Parameters : none                                                        |}
  2134. {| Returns    : none                                                        |}
  2135. {| Notes      : Don't actually need an open file to execute this method.    |}
  2136. {+--------------------------------------------------------------------------+}
  2137. Procedure BtrieveFile.AbortTransaction;
  2138.  
  2139.   var
  2140.     I : Integer;
  2141.     W : Word;
  2142.  
  2143.   begin
  2144.     Repeat
  2145.       Status := Btrv(bAbortTransaction, I, I, W, I, 0);
  2146.     Until (not Error(Status, bAbortTransaction, Path));
  2147.   end;
  2148.  
  2149. {+--------------------------------------------------------------------------+}
  2150. {| Name       : Stat                                                        |}
  2151. {| Class      : BtrieveFile                                                 |}
  2152. {| Purpose    : Execute the stat operation.                                 |}
  2153. {| Parameters : FDATA - will hold the statistics for the file               |}
  2154. {| Returns    : none                                                        |}
  2155. {+--------------------------------------------------------------------------+}
  2156. Procedure BtrieveFile.Stat(var FData : FileSpec);
  2157.  
  2158.   var
  2159.     FName : Array[1..128] of Char;
  2160.  
  2161.   begin
  2162.     BytesRead := SizeOf(FData);
  2163.  
  2164.     Repeat
  2165.       Status := Btrv(bStat, PosBlock, FData, BytesRead, FName, 0);
  2166.     Until (not Error(Status, bStat, Path));
  2167.   end;
  2168.  
  2169. {+--------------------------------------------------------------------------+}
  2170. {| Name       : Version                                                     |}
  2171. {| Class      : BtrieveWorkStation                                          |}
  2172. {| Purpose    : Get the version of btrieve being used                       |}
  2173. {| Parameters : ver - major version number                                  |}
  2174. {|              rev - minor version number                                  |}
  2175. {|              flag- an "N" indicates a network version                    |}
  2176. {| Returns    : none                                                        |}
  2177. {| Notes      : Don't actually need an open file to execute this method.    |}
  2178. {+--------------------------------------------------------------------------+}
  2179. Procedure BtrieveFile.Version(var Ver    : Word;
  2180.                               var Rev    : Word;
  2181.                               var OSFlag : Char);
  2182.  
  2183.   var
  2184.     I       : Integer;
  2185.     BufSize : Word;
  2186.     Buffer  : Array[0..19] of Byte;
  2187.  
  2188.   begin
  2189.     BufSize := 20;                          { init length }
  2190.  
  2191.     Repeat
  2192.       Status := Btrv(bVersion, I, Buffer, BufSize, I, 0);
  2193.     Until (not Error(Status, bVersion, ''));
  2194.  
  2195.     Move(Buffer[0], Ver, 2);                { set version number  }
  2196.     Move(Buffer[2], Rev, 2);                { set revision number }
  2197.     Move(Buffer[4], OSFlag,1);              { set network flag    }
  2198.   end;
  2199.  
  2200. {+--------------------------------------------------------------------------+}
  2201. {| Name       : Unload                                                      |}
  2202. {| Class      : BtrieveFile                                                 |}
  2203. {| Purpose    : Unload btrieve.                                             |}
  2204. {| Parameters : none                                                        |}
  2205. {| Returns    : none                                                        |}
  2206. {| Notes      : Don't actually need an open file to execute this method.    |}
  2207. {+--------------------------------------------------------------------------+}
  2208. Procedure BtrieveFile.Unload;
  2209.  
  2210.   var
  2211.     I : Integer;
  2212.     W : Word;
  2213.  
  2214.   begin
  2215.     Repeat
  2216.       Status := Btrv(bStop, I, I, W, I, 0);
  2217.     Until (not Error(Status, bStop, ''));
  2218.   end;
  2219.  
  2220. {+--------------------------------------------------------------------------+}
  2221. {| Name       : Reset                                                       |}
  2222. {| Class      : BtrieveFile                                                 |}
  2223. {| Purpose    : Reset btrieve and release all workstation resources.        |}
  2224. {| Parameters : none                                                        |}
  2225. {| Returns    : none                                                        |}
  2226. {| Notes      : Don't actually need an open file to execute this method.    |}
  2227. {+--------------------------------------------------------------------------+}
  2228. Procedure BtrieveFile.Reset;
  2229.  
  2230.   var
  2231.     I : Integer;
  2232.     W : Word;
  2233.  
  2234.   begin
  2235.     Repeat
  2236.       Status := Btrv(bReset, I, I, W, I, 0);
  2237.     Until (not Error(Status, bStop, ''));
  2238.   end;
  2239.  
  2240.  
  2241. {****************************************************************************
  2242.                        Error Handler Object
  2243. ****************************************************************************}
  2244. {+--------------------------------------------------------------------------+}
  2245. {| Name       : Init                                                        |}
  2246. {| Class      : ErrorHandler                                                |}
  2247. {| Purpose    : Initialize an errror handler object                         |}
  2248. {| Parameters : DisplayObject - pointer to user defined error display object|}
  2249. {| Returns    : none                                                        |}
  2250. {| Notes      : Sets the default error set to all errors except bEOF and    |}
  2251. {|              bKeyNotFound.                                               |}
  2252. {+--------------------------------------------------------------------------+}
  2253. Constructor ErrorHandler.Init(DisplayObject : PErrorDisplay);
  2254.   begin
  2255.     RetryCount := 0;
  2256.     MaxRetry   := 5;
  2257.     { turn seconds into milliseconds }
  2258.     RetryDelay  := 5000;
  2259.     ErrDisplay  := DisplayObject;
  2260.     { init Errors handled to all except End Of File }
  2261.     TrappedErrors := [bInvalidOp..bLastError] - [bEOF];
  2262.   end;
  2263.  
  2264. {+--------------------------------------------------------------------------+}
  2265. {| Name       : Done                                                        |}
  2266. {| Class      : ErrorHandler                                                |}
  2267. {| Purpose    : Destroy the object                                          |}
  2268. {| Parameters : none                                                        |}
  2269. {| Returns    : none                                                        |}
  2270. {+--------------------------------------------------------------------------+}
  2271. Destructor ErrorHandler.Done;
  2272.   begin
  2273.   end;
  2274.  
  2275. {+--------------------------------------------------------------------------+}
  2276. {| Name       : ErrorMsg                                                    |}
  2277. {| Class      : ErrorHandler                                                |}
  2278. {| Purpose    : Return the message for a btrieve error code                 |}
  2279. {| Parameters : ErrorCode - a btrieve status code                           |}
  2280. {| Returns    : A message string                                            |}
  2281. {+--------------------------------------------------------------------------+}
  2282. Function ErrorHandler.ErrorMsg(ErrorCode : Integer): String;
  2283.   begin
  2284.     Case ErrorCode of
  2285.       bOkay               : ErrorMsg := 'No error';
  2286.       bInvalidOp          : ErrorMsg := 'Invalid operation';
  2287.       bIOerror            : ErrorMsg := 'I/O error';
  2288.       bFileNotOpen        : ErrorMsg := 'File not open';
  2289.       bKeyNotFound        : ErrorMsg := 'Key value not found';
  2290.       bDuplicateKey       : ErrorMsg := 'Duplicate keys not allowed';
  2291.       bInvalidKey         : ErrorMsg := 'Invalid key number';
  2292.       bDifferentKey       : ErrorMsg := 'Different key number from previous read';
  2293.       bInvalidPos         : ErrorMsg := 'Invalid file positioning';
  2294.       bEOF                : ErrorMsg := 'End of file';
  2295.       bKeyModifyErr       : ErrorMsg := 'Key data may not be modified';
  2296.       bInvalidName        : ErrorMsg := 'Invalid file name';
  2297.       bFileNotFound       : ErrorMsg := 'File not found';
  2298.       bPreImageOpenErr    : ErrorMsg := 'Pre-Image file open error';
  2299.       bPreImageIOErr      : ErrorMsg := 'Pre-Image file I/O error';
  2300.       bExpansionErr       : ErrorMsg := 'Expansion file error';
  2301.       bCloseErr           : ErrorMsg := 'Close error';
  2302.       bDiskFull           : ErrorMsg := 'Disk full';
  2303.       bUnRecoverableErr   : ErrorMsg := 'Unrecoverable error, File may be corrupt';
  2304.       bNotLoaded          : ErrorMsg := 'Record Manager not loaded';
  2305.       bKeyBufferShort     : ErrorMsg := 'Key buffer too short';
  2306.       bDataBufferShort    : ErrorMsg := 'Data buffer too short';
  2307.       bPosBlockShort      : ErrorMsg := 'Position block is not 128 bytes in size';
  2308.       bPageSizeErr        : ErrorMsg := 'Page size error';
  2309.       bCreateIOErr        : ErrorMsg := 'File creation error';
  2310.       bNumberKeys         : ErrorMsg := 'Number of keys is invalid';
  2311.       bInvalidKeyPos      : ErrorMsg := 'Invalid key position';
  2312.       bRecordLenErr       : ErrorMsg := 'Invalid record length';
  2313.       bKeyLenErr          : ErrorMsg := 'Invalid key length';
  2314.       bNotBtrieveFile     : ErrorMsg := 'File is not a Btrieve file';
  2315.       bTransactionErr     : ErrorMsg := '/T option was not specified';
  2316.       bTransactionActive  : ErrorMsg := 'A transaction is already active';
  2317.       bTransactionFileErr : ErrorMsg := 'Transaction control file I/O error';
  2318.       bTransactionEndErr  : ErrorMsg := 'No begin transaction issued';
  2319.       bTransactionMaxFiles: ErrorMsg := 'Maximum number of transaction files (12) exceeded';
  2320.       bOpNotAllowed       : ErrorMsg := 'Operation not allowed';
  2321.       bAcceleratedErr     : ErrorMsg := 'Incomplete accelerated access, File may be corrupt';
  2322.       bInvalidAddress     : ErrorMsg := 'Invalid record address';
  2323.       bNullKeypath        : ErrorMsg := 'Null key path';
  2324.       bBadKeyFlags        : ErrorMsg := 'Inconsistent key flags';
  2325.       bFileAccessDenied   : ErrorMsg := 'Access to file denied';
  2326.       bMaxOpenFiles       : ErrorMsg := 'Maximum number of files open';
  2327.       bInvalidAltSequence : ErrorMsg := 'Invalid alternate collating sequence definition';
  2328.       bKeyTypeErr         : ErrorMsg := 'Key type error';
  2329.       bOwnerIsSet         : ErrorMsg := 'Owner is already set';
  2330.       bInvalidOwner       : ErrorMsg := 'Invalid owner';
  2331.       bCacheWriteErr      : ErrorMsg := 'Error writing cache buffer';
  2332.       bInvalidVersion     : ErrorMsg := 'Invalid Btrieve version';
  2333.       bVariablePageErr    : ErrorMsg := 'Variable page error';
  2334.       bAutoIncrementErr   : ErrorMsg := 'Autoincrement key error';
  2335.       bBadIndex           : ErrorMsg := 'A supplemental index is damaged';
  2336.       bExpandedMemoryErr  : ErrorMsg := 'Expanded memory error';
  2337.       bCompressBuffShort  : ErrorMsg := 'Compression buffer too short';
  2338.       bFileExists         : ErrorMsg := 'File already exists';
  2339.       bTTSabort           : ErrorMsg := 'Automatic transaction abort';
  2340.       bDeadlock           : ErrorMsg := 'Deadlock detected';
  2341.       bConflict           : ErrorMsg := 'Record has been changed';
  2342.       bLockErr            : ErrorMsg := 'File lock error';
  2343.       bLostPosition       : ErrorMsg := 'File positioning lost';
  2344.       bOutOfTransaction   : ErrorMsg := 'Read outside of a transaction';
  2345.       bRecordInUse        : ErrorMsg := 'Record in use';
  2346.       bFileInUse          : ErrorMsg := 'File in use';
  2347.       bFileTblFull        : ErrorMsg := 'File table is full';
  2348.       bHandleTblFull      : ErrorMsg := 'No file handles available';
  2349.       bBadModeErr         : ErrorMsg := 'Incompatible file open mode';
  2350.       bDeviceTableFull    : ErrorMsg := 'Redirected device table full';
  2351.       bServerErr          : ErrorMsg := 'Server error';
  2352.       bTranTableFull      : ErrorMsg := 'Transaction table full';
  2353.       bBadLockType        : ErrorMsg := 'Lock types are incompatible';
  2354.       bPermissionErr      : ErrorMsg := 'Permission error';
  2355.       bSessionInvalid     : ErrorMsg := 'Session no longer valid';
  2356.       bCommunicationErr   : ErrorMsg := 'Communications environment error';
  2357.       bDataMessageShort   : ErrorMsg := 'Data message to small';
  2358.       bInternalTTSerr     : ErrorMsg := 'Internal TTS error';
  2359.       bOutOfMemory        : ErrorMsg := 'Out of Memory';
  2360.       else
  2361.         ErrorMsg := 'Unknown error';
  2362.     end;
  2363.   end;
  2364.  
  2365. {+--------------------------------------------------------------------------+}
  2366. {| Name       : OpMsg                                                        |}
  2367. {| Class      : ErrorHandler                                                |}
  2368. {| Purpose    : Return the message for a btrieve error code                 |}
  2369. {| Parameters : ErrorCode - a btrieve status code                           |}
  2370. {| Returns    : A message string                                            |}
  2371. {+--------------------------------------------------------------------------+}
  2372. Function ErrorHandler.OpMsg(OpCode : Integer): String;
  2373.   begin
  2374.     Case OpCode of
  2375.       bOpen             : OpMsg := 'Open file';
  2376.       bClose            : OpMsg := 'Close file';
  2377.       bInsert           : OpMsg := 'Insert new record';
  2378.       bUpdate           : OpMsg := 'Update existing record';
  2379.       bDelete           : OpMsg := 'Delete record';
  2380.       bGetEqual         : OpMsg := 'Read record equal to key';
  2381.       bGetGreat         : OpMsg := 'Read record greater than key';
  2382.       bGetGreatEqual    : OpMsg := 'Read record greater than or equal to key';
  2383.       bGetLess          : OpMsg := 'Read record less than key';
  2384.       bGetLessEqual     : OpMsg := 'Read record less than or equal to key';
  2385.       bGetNext          : OpMsg := 'Read next record';
  2386.       bGetPrev          : OpMsg := 'Read previous record';
  2387.       bGetFirst         : OpMsg := 'Read first record';
  2388.       bGetLast          : OpMsg := 'Read last record';
  2389.       bCreate           : OpMsg := 'Create file';
  2390.       bStat             : OpMsg := 'Get file statistics';
  2391.       bBeginTransaction : OpMsg := 'Begin transaction';
  2392.       bEndTransaction   : OpMsg := 'End transaction';
  2393.       bAbortTransaction : OpMsg := 'Abort transaction';
  2394.       bGetPosition      : OpMsg := 'Get record position';
  2395.       bGetDirect        : OpMsg := 'Read record by position';
  2396.       bStepNext         : OpMsg := 'Step to next record';
  2397.       bStop             : OpMsg := 'Unload record manager';
  2398.       bVersion          : OpMsg := 'Get version number';
  2399.       bUnlock           : OpMsg := 'Unlock';
  2400.       bReset            : OpMsg := 'Reset record manager';
  2401.       bSetOwner         : OpMsg := 'Set file owner';
  2402.       bClearOwner       : OpMsg := 'Clear file owner';
  2403.       bCreateIndex      : OpMsg := 'Creating supplemental index';
  2404.       bDropIndex        : OpMsg := 'Dropping supplemental index';
  2405.       bStepFirst        : OpMsg := 'Step to first record';
  2406.       bStepLast         : OpMsg := 'Step to last record';
  2407.       bStepPrev         : OpMsg := 'Step to previous record';
  2408.  
  2409.       else
  2410.         OpMsg := 'Unknown operation';
  2411.     end;
  2412.   end;
  2413.  
  2414. {+--------------------------------------------------------------------------+}
  2415. {| Name       : SetMaxRetry                                                 |}
  2416. {| Class      : ErrorHandler                                                |}
  2417. {| Purpose    : Set the maximum number of retries for lock errors           |}
  2418. {| Parameters : Retry - max. retries                                        |}
  2419. {| Returns    : none                                                        |}
  2420. {+--------------------------------------------------------------------------+}
  2421. Procedure ErrorHandler.SetMaxRetry(Retry : Word);
  2422.   begin
  2423.     MaxRetry := Retry;
  2424.   end;
  2425.  
  2426. {+--------------------------------------------------------------------------+}
  2427. {| Name       : GetMaxRetry                                                 |}
  2428. {| Class      : ErrorHandler                                                |}
  2429. {| Purpose    : Get max. number of retries                                   |}
  2430. {| Parameters : none                                                        |}
  2431. {| Returns    : Maximum number of retries                                    |}
  2432. {+--------------------------------------------------------------------------+}
  2433. Function ErrorHandler.GetMaxRetry: Word;
  2434.   begin
  2435.     GetMaxRetry := MaxRetry;
  2436.   end;
  2437.  
  2438. {+--------------------------------------------------------------------------+}
  2439. {| Name       : ClearRetry                                                  |}
  2440. {| Class      : ErrorHandler                                                |}
  2441. {| Purpose    : Clear the current number of retries                          |}
  2442. {| Parameters : none                                                        |}
  2443. {| Returns    : none                                                        |}
  2444. {+--------------------------------------------------------------------------+}
  2445. Procedure ErrorHandler.ClearRetry;
  2446.   begin
  2447.     { clear the current retry count }
  2448.     RetryCount  := 0;
  2449.   end;
  2450.  
  2451. {+--------------------------------------------------------------------------+}
  2452. {| Name       : SetDelay                                                    |}
  2453. {| Class      : ErrorHandler                                                |}
  2454. {| Purpose    : Set the delay between lock retries                           |}
  2455. {| Parameters : Seconds - how long to wait                                  |}
  2456. {| Returns    : none                                                        |}
  2457. {+--------------------------------------------------------------------------+}
  2458. Procedure ErrorHandler.SetDelay(Seconds : Word);
  2459.   begin
  2460.     { turn seconds into milliseconds }
  2461.     RetryDelay  := Seconds * 1000;
  2462.   end;
  2463.  
  2464. {+--------------------------------------------------------------------------+}
  2465. {| Name       : GetDelay                                                    |}
  2466. {| Class      : ErrorHandler                                                |}
  2467. {| Purpose    : Get the seconds of delay between lock retries                |}
  2468. {| Parameters : none                                                        |}
  2469. {| Returns    : Seconds delay                                               |}
  2470. {+--------------------------------------------------------------------------+}
  2471. Function ErrorHandler.GetDelay: Word;
  2472.   begin
  2473.     { turn milliseconds into seconds }
  2474.     GetDelay  := RetryDelay Div 1000;
  2475.   end;
  2476.  
  2477. {+--------------------------------------------------------------------------+}
  2478. {| Name       : AddError                                                    |}
  2479. {| Class      : ErrorHandler                                                |}
  2480. {| Purpose    : Add an error to the trapped error set                       |}
  2481. {| Parameters : ErrorCode - btrieve status code to add                      |}
  2482. {| Returns    : none                                                        |}
  2483. {| Notes      : All errors except bEOF are trapped by default               |}
  2484. {+--------------------------------------------------------------------------+}
  2485. Procedure ErrorHandler.AddErrors(ErrorCodes : ErrorSet);
  2486.   begin
  2487.     TrappedErrors := TrappedErrors + ErrorCodes;
  2488.   end;
  2489.  
  2490. {+--------------------------------------------------------------------------+}
  2491. {| Name       : RemoveError                                                 |}
  2492. {| Class      : ErrorHandler                                                |}
  2493. {| Purpose    : Remove a error form the trapped errors                      |}
  2494. {| Parameters : ErrorCode - btrieve status code to remove                   |}
  2495. {| Parameters : none                                                        |}
  2496. {| Returns    : none                                                        |}
  2497. {| Notes      : bOkay will not be removed.                                  |}
  2498. {|              All errors except bEOF are trapped by default               |}
  2499. {+--------------------------------------------------------------------------+}
  2500. Procedure ErrorHandler.RemoveErrors(ErrorCodes : ErrorSet);
  2501.   begin
  2502.     TrappedErrors := TrappedErrors - ErrorCodes;
  2503.   end;
  2504.  
  2505. {+--------------------------------------------------------------------------+}
  2506. {| Name       : SetErrors                                                   |}
  2507. {| Class      : ErrorHandler                                                |}
  2508. {| Purpose    : Make the set of all trapped errors.                         |}
  2509. {| Parameters : ErrorCodes - A set of btrieve status codes to become the new|}
  2510. {|                           trapped error set.                             |}
  2511. {| Returns    : none                                                        |}
  2512. {+--------------------------------------------------------------------------+}
  2513. Procedure ErrorHandler.SetErrors(ErrorCodes : ErrorSet);
  2514.   begin
  2515.     TrappedErrors := ErrorCodes;
  2516.   end;
  2517.  
  2518. {+--------------------------------------------------------------------------+}
  2519. {| Name       : GetErrors                                                   |}
  2520. {| Class      : ErrorHandler                                                |}
  2521. {| Purpose    : Return the set of all trapped errors.                       |}
  2522. {| Parameters : ErrorCodes - The set of btrieve status codes currently      |}
  2523. {|              trapped.                                                    |}
  2524. {| Returns    : none                                                        |}
  2525. {+--------------------------------------------------------------------------+}
  2526. Procedure ErrorHandler.GetErrors(var ErrorCodes : ErrorSet);
  2527.   begin
  2528.     ErrorCodes  := TrappedErrors;
  2529.   end;
  2530.  
  2531. {+--------------------------------------------------------------------------+}
  2532. {| Name       : ErrorDispatcher                                             |}
  2533. {| Class      : ErrorHandler                                                |}
  2534. {| Purpose    : This routine calls the error display object and if the error|}
  2535. {|              display object says abort halts the program.                |}
  2536. {| Parameters : ErrorCode - btrieve error                                   |}
  2537. {|              OpCode    - btrieve operation that generate error           |}
  2538. {|              FileName  - file the error occured with                     |}
  2539. {| Returns    : If error is not fatal, a flag of type ErrorAction indicating|}
  2540. {|              continue or start over.                                     |}
  2541. {| Notes      : Assumes there is an exit routine that will Reset btrieve if |}
  2542. {|              desired.                                                    |}
  2543. {+--------------------------------------------------------------------------+}
  2544. Function ErrorHandler.ErrorDispacther(ErrorCode : Integer;
  2545.                                       OpCode    : Byte;
  2546.                                       FileName  : PathStr
  2547.                                      ): ErrorAction;
  2548.  
  2549.   var
  2550.     Action  : ErrorAction;
  2551.  
  2552.   begin
  2553.     { call error object to display the error messages }
  2554.     { and see if user wants to stop                   }
  2555.     if (ErrDisplay <> nil) then
  2556.     begin
  2557.       Action := ErrDisplay^.Display(ErrorCode,
  2558.                                     ErrorMsg(ErrorCode),
  2559.                                     OpCode,
  2560.                                     OpMsg(OpCode),
  2561.                                     FileName);
  2562.  
  2563.       { the error is fatal, so abort through the defined exit procedure }
  2564.       if (Action = erAbort) then
  2565.         Halt(ErrorCode);
  2566.     end
  2567.  
  2568.     else
  2569.     begin
  2570.       Action := erDone;
  2571.     end;
  2572.  
  2573.     { clear retries so we are ready for more looping }
  2574.     ClearRetry;
  2575.     ErrorDispacther := Action;
  2576.   end;
  2577.  
  2578. {+--------------------------------------------------------------------------+}
  2579. {| Name       : Error                                                       |}
  2580. {| Class      : ErrorHandler                                                |}
  2581. {| Purpose    : Traps all non-programmer errors                             |}
  2582. {| Parameters : Status    - the last btrieve status code                    |}
  2583. {|              OpCode    - btrieve operation that generate error           |}
  2584. {|              FileName  - file the error occured with                     |}
  2585. {| Returns    : TRUE as long as there is still an error.                    |}
  2586. {| Notes      : This routine is called by all routines that execute a       |}
  2587. {|              btrieve operation. Any errors that are removed by a call to |}
  2588. {|              RemoveError will return to the user program,all other errors|}
  2589. {|              will be trapped. Lock errors (bRecordInUse, bFileInUse)     |}
  2590. {|              enter the retry loop.                                       |}
  2591. {+--------------------------------------------------------------------------+}
  2592. Function ErrorHandler.Error(Status   : Integer;
  2593.                             OpCode   : Byte;
  2594.                             FileName : PathStr
  2595.                            ): Boolean;
  2596.   begin
  2597.     { handle all trapped errors }
  2598.     if (Status in TrappedErrors) then
  2599.     begin
  2600.       { these are lock errors }
  2601.       if (Status = bRecordInUse) or (Status = bFileInUse) then
  2602.       begin
  2603.         { if there are retries left }
  2604.         if (RetryCount < MaxRetry) then
  2605.         begin
  2606.           Inc(RetryCount);
  2607.           Delay(RetryDelay);
  2608.           Error := True;
  2609.         end
  2610.  
  2611.         { else go see what the user wants to do }
  2612.         else
  2613.           { error dispatcher returns either a continue or start over }
  2614.           Error := (ErrorDispacther(Status, OpCode, FileName) = erRetry);
  2615.       end
  2616.  
  2617.       { any other error go see what the user wants to do }
  2618.       else
  2619.         { error dispatcher returns either a continue or start over }
  2620.         Error := (ErrorDispacther(Status, OpCode, FileName) = erRetry);
  2621.     end {if}
  2622.  
  2623.     { else this is a programmer handled error }
  2624.     else
  2625.     begin
  2626.       { return with "No more error"  status }
  2627.       Error := False;
  2628.       { clear the retry counter so we are ready for more looping }
  2629.       ClearRetry;
  2630.     end; {else}
  2631.   end;
  2632.  
  2633. {****************************************************************************
  2634.                          ERROR DISPLAY OBJECT
  2635.  Note: These are abstract routines and provide no functionality they are
  2636.        shells only. For each instance you must override these routines.
  2637. ****************************************************************************=}
  2638. {+--------------------------------------------------------------------------+}
  2639. {| Name       : Init                                                        |}
  2640. {| Class      : ErrorDisplay                                                |}
  2641. {| Purpose    : Initialize the error display object.                        |}
  2642. {| Parameters : none                                                        |}
  2643. {| Returns    : none                                                        |}
  2644. {+--------------------------------------------------------------------------+}
  2645. Constructor ErrorDisplay.Init;
  2646.   begin
  2647.   end;
  2648.  
  2649. {+--------------------------------------------------------------------------+}
  2650. {| Name       : Display                                                     |}
  2651. {| Class      : ErrorDisplay                                                |}
  2652. {| Purpose    : Display an error passed from the error handler              |}
  2653. {| Parameters : ErrorNumber - the btrieve code that caused the call         |}
  2654. {|              OpCode      - btrieve operation that generate error         |}
  2655. {|              ErrorMsg    - error description                             |}
  2656. {|              FileName    - file the error occured with                   |}
  2657. {| Returns    : Returns a flag of type ErrorAction indicating whether the   |}
  2658. {|              program should Abort, Continue, or Start Over.              |}
  2659. {| Notes      : In practice this routine must check the error and decide    |}
  2660. {|              what to do. This is where errors will be displayed and any  |}
  2661. {|              user response recieved. However the error is handled, this  |}
  2662. {|              routine must return some action (erAbort, erDone, erRetry)  |}
  2663. {|              to tell the error handler what to do next.                  |}
  2664. {+--------------------------------------------------------------------------+}
  2665. Function ErrorDisplay.Display(Error     : Integer;
  2666.                               ErrorMsg  : String;
  2667.                               OpCode    : Byte;
  2668.                               OpCodeMsg : String;
  2669.                               FileName  : PathStr
  2670.                              ): ErrorAction;
  2671.   begin
  2672.     { this procedure is virtual and must always be overridden }
  2673.     { a call here is illegal, so generate a runtime error     }
  2674.     RunError(211);
  2675.   end;
  2676.  
  2677. {+--------------------------------------------------------------------------+}
  2678. {| Name       : Done                                                        |}
  2679. {| Class      : ErrorDisplay                                                |}
  2680. {| Purpose    : Destroy the object                                          |}
  2681. {| Parameters : none                                                        |}
  2682. {| Returns    : none                                                        |}
  2683. {+--------------------------------------------------------------------------+}
  2684. Destructor ErrorDisplay.Done;
  2685.   begin
  2686.   end;
  2687.  
  2688. {****************************************************************************
  2689.                          PROGRESS DISPLAY OBJECT
  2690.  Note: These are abstract routines and provide no functionality they are
  2691.        shells only. For each instance you must override these routines.
  2692. ****************************************************************************=}
  2693. {+--------------------------------------------------------------------------+}
  2694. {| Name       : Init                                                        |}
  2695. {| Class      : TProgress                                                   |}
  2696. {| Purpose    : Initialize the progress in display object.                  |}
  2697. {| Parameters : None                                                        |}
  2698. {| Returns    : None                                                        |}
  2699. {+--------------------------------------------------------------------------+}
  2700. Constructor TProgress.Init;
  2701.   begin
  2702.   end;
  2703.  
  2704. {+--------------------------------------------------------------------------+}
  2705. {| Name       : Display                                                     |}
  2706. {| Class      : TProgress                                                   |}
  2707. {| Purpose    : Display an the progress in during recover, save or load.    |}
  2708. {| Parameters : Count - current record count                                |}
  2709. {| Returns    : None                                                        |}
  2710. {| Notes      : In practice this routine would display some sort of progress|}
  2711. {|              update to calm the users fears that her amchine has locked. |}
  2712. {+--------------------------------------------------------------------------+}
  2713. Procedure TProgress.Display(Count : LongInt);
  2714.   begin
  2715.   end;
  2716.  
  2717.  
  2718. {+--------------------------------------------------------------------------+}
  2719. {| Name       : CheckForBtrieve                                             |}
  2720. {| Purpose    : See if Btrieve is loaded and abort if it is not.            |}
  2721. {| Parameters : none                                                        |}
  2722. {| Returns    : none                                                        |}
  2723. {| Notes      : Prints a message to the screen and halts with exit code 999 |}
  2724. {|              if Btrieve is not found.                                    |}
  2725. {+--------------------------------------------------------------------------+}
  2726. Procedure CheckForBtrieve;
  2727.  
  2728.   var
  2729.     I     : Integer;
  2730.     W     : Word;
  2731.     Regs  : Registers;
  2732.     St    : String[80];
  2733.     Len   : Byte Absolute St;
  2734.     Temp  : Array[0..80] of Char;
  2735.  
  2736.   begin
  2737.     { try a reset to see if Btrieve is loaded }
  2738.     if (Btrv(bReset, I, I, W, I, 0) <> bOkay) then
  2739.     begin
  2740.       { display a message and halt  }
  2741.       St := 'Btrieve Record Manager is not loaded, program aborted!';
  2742.       Move(St[1], Temp[0], Len);
  2743.       Temp[Len]   := #13;
  2744.       Temp[Len+1] := #10;
  2745.       Temp[Len+2] := '$';
  2746.       Regs.DS := Seg(Temp);
  2747.       Regs.DX := Ofs(Temp);
  2748.       Regs.AH := $09;
  2749.       { call DOS int 21h function 09h to print the string because unlike
  2750.         Turbo's Writeln this output will get redirected
  2751.       }
  2752.       MsDos(Regs);
  2753.       { halt with some non-zero error so a parent process can tell
  2754.         there was a problem
  2755.       }
  2756.       Halt(999);
  2757.     end;
  2758.   end;
  2759.  
  2760.  
  2761. {+--------------------------------------------------------------------------+}
  2762. {| Name       : HeapFunc                                                    |}
  2763. {| Purpose    : Make sure New and GetMem return nil on errors.              |}
  2764. {+--------------------------------------------------------------------------+}
  2765. Function HeapFunc(Size : Word): Integer;  FAR;
  2766.   begin
  2767.     HeapFunc := 1;
  2768.   end;
  2769.  
  2770.  
  2771. BEGIN
  2772.   HeapError := @HeapFunc;   { Add a heap function so errors return nil  }
  2773.  
  2774.   {$IFDEF BCHECK}
  2775.   CheckForBtrieve;
  2776.   {$ENDIF}
  2777. END.